Theory Auxiliary
section ‹Auxiliary Definitions›
theory Auxiliary
imports Complex_Main "HOL-Library.While_Combinator"
begin
declare
option.splits[split]
Let_def[simp]
subset_insertI2 [simp]
Cons_eq_map_conv [iff]
lemma nat_add_max_le[simp]:
"((n::nat) + max i j ≤ m) = (n + i ≤ m ∧ n + j ≤ m)"
by arith
lemma Suc_add_max_le[simp]:
"(Suc(n + max i j) ≤ m) = (Suc(n + i) ≤ m ∧ Suc(n + j) ≤ m)"
by arith
notation Some ("(⌊_⌋)")
lemma butlast_tail:
"butlast (Xs@[X,Y]) = Xs@[X]"
by (induct Xs) auto
lemma butlast_noteq:"Cs ≠ [] ⟹ butlast Cs ≠ Cs"
by(induct Cs)simp_all
lemma app_hd_tl:"⟦Cs ≠ []; Cs = Cs' @ tl Cs⟧ ⟹ Cs' = [hd Cs]"
apply (subgoal_tac "[hd Cs] @ tl Cs = Cs' @ tl Cs")
apply fast
apply simp
done
lemma only_one_append:"⟦C' ∉ set Cs; C' ∉ set Cs'; Ds@ C'#Ds' = Cs@ C'#Cs'⟧
⟹ Cs = Ds ∧ Cs' = Ds'"
apply -
apply (simp add:append_eq_append_conv2)
apply (auto simp:in_set_conv_decomp)
apply (subgoal_tac "hd (us @ C'#Ds') = C'")
apply (case_tac us)
apply simp
apply fastforce
apply simp
apply (subgoal_tac "hd (us @ C'#Ds') = C'")
apply (case_tac us)
apply simp
apply fastforce
apply simp
apply (subgoal_tac "hd (us @ C'#Cs') = C'")
apply (case_tac us)
apply simp
apply fastforce
apply (subgoal_tac "hd(C'#Ds') = C'")
apply simp
apply (simp (no_asm))
apply (subgoal_tac "hd (us @ C'#Cs') = C'")
apply (case_tac us)
apply simp
apply fastforce
apply (subgoal_tac "hd(C'#Ds') = C'")
apply simp
apply (simp (no_asm))
done
definition pick :: "'a set ⇒ 'a" where
"pick A ≡ SOME x. x ∈ A"
lemma pick_is_element:"x ∈ A ⟹ pick A ∈ A"
by (unfold pick_def,rule_tac x="x" in someI)
definition set2list :: "'a set ⇒ 'a list" where
"set2list A ≡ fst (while (λ(Es,S). S ≠ {})
(λ(Es,S). let x = pick S in (x#Es,S-{x}))
([],A) )"
lemma card_pick:"⟦finite A; A ≠ {}⟧ ⟹ Suc(card(A-{pick(A)})) = card A"
by (drule card_Suc_Diff1,auto dest!:pick_is_element simp:ex_in_conv)
lemma set2list_prop:"⟦finite A; A ≠ {}⟧ ⟹
∃xs. while (λ(Es,S). S ≠ {})
(λ(Es,S). let x = pick S in (x#Es,S-{x}))
([],A) = (xs,{}) ∧ (set xs ∪ {} = A)"
apply(rule_tac P="(λxs. (set(fst xs) ∪ snd xs = A))" and
r="measure (card o snd)" in while_rule)
apply(auto dest:pick_is_element)
apply(auto dest:card_pick simp:ex_in_conv measure_def inv_image_def)
done
lemma set2list_correct:"⟦finite A; A ≠ {}; set2list A = xs⟧ ⟹ set xs = A"
by (auto dest:set2list_prop simp:set2list_def)
subsection ‹‹distinct_fst››
definition distinct_fst :: "('a × 'b) list ⇒ bool" where
"distinct_fst ≡ distinct ∘ map fst"
lemma distinct_fst_Nil [simp]:
"distinct_fst []"
apply (unfold distinct_fst_def)
apply (simp (no_asm))
done
lemma distinct_fst_Cons [simp]:
"distinct_fst ((k,x)#kxs) = (distinct_fst kxs ∧ (∀y. (k,y) ∉ set kxs))"
apply (unfold distinct_fst_def)
apply (auto simp:image_def)
done
lemma map_of_SomeI:
"⟦ distinct_fst kxs; (k,x) ∈ set kxs ⟧ ⟹ map_of kxs k = Some x"
by (induct kxs) (auto simp:fun_upd_apply)
subsection ‹Using @{term list_all2} for relations›
definition fun_of :: "('a × 'b) set ⇒ 'a ⇒ 'b ⇒ bool" where
"fun_of S ≡ λx y. (x,y) ∈ S"
text ‹Convenience lemmas›
declare fun_of_def [simp]
lemma rel_list_all2_Cons [iff]:
"list_all2 (fun_of S) (x#xs) (y#ys) =
((x,y) ∈ S ∧ list_all2 (fun_of S) xs ys)"
by simp
lemma rel_list_all2_Cons1:
"list_all2 (fun_of S) (x#xs) ys =
(∃z zs. ys = z#zs ∧ (x,z) ∈ S ∧ list_all2 (fun_of S) xs zs)"
by (cases ys) auto
lemma rel_list_all2_Cons2:
"list_all2 (fun_of S) xs (y#ys) =
(∃z zs. xs = z#zs ∧ (z,y) ∈ S ∧ list_all2 (fun_of S) zs ys)"
by (cases xs) auto
lemma rel_list_all2_refl:
"(⋀x. (x,x) ∈ S) ⟹ list_all2 (fun_of S) xs xs"
by (simp add: list_all2_refl)
lemma rel_list_all2_antisym:
"⟦ (⋀x y. ⟦(x,y) ∈ S; (y,x) ∈ T⟧ ⟹ x = y);
list_all2 (fun_of S) xs ys; list_all2 (fun_of T) ys xs ⟧ ⟹ xs = ys"
by (rule list_all2_antisym) auto
lemma rel_list_all2_trans:
"⟦ ⋀a b c. ⟦(a,b) ∈ R; (b,c) ∈ S⟧ ⟹ (a,c) ∈ T;
list_all2 (fun_of R) as bs; list_all2 (fun_of S) bs cs⟧
⟹ list_all2 (fun_of T) as cs"
by (rule list_all2_trans) auto
lemma rel_list_all2_update_cong:
"⟦ i<size xs; list_all2 (fun_of S) xs ys; (x,y) ∈ S ⟧
⟹ list_all2 (fun_of S) (xs[i:=x]) (ys[i:=y])"
by (simp add: list_all2_update_cong)
lemma rel_list_all2_nthD:
"⟦ list_all2 (fun_of S) xs ys; p < size xs ⟧ ⟹ (xs!p,ys!p) ∈ S"
by (drule list_all2_nthD) auto
lemma rel_list_all2I:
"⟦ length a = length b; ⋀n. n < length a ⟹ (a!n,b!n) ∈ S ⟧ ⟹ list_all2 (fun_of S) a b"
by (erule list_all2_all_nthI) simp
declare fun_of_def [simp del]
end
Theory Type
section ‹CoreC++ types›
theory Type imports Auxiliary begin
type_synonym cname = string
type_synonym mname = string
type_synonym vname = string
definition this :: vname where
"this ≡ ''this''"
datatype ty
= Void
| Boolean
| Integer
| NT
| Class cname
datatype base
= Repeats cname
| Shares cname
primrec getbase :: "base ⇒ cname" where
"getbase (Repeats C) = C"
| "getbase (Shares C) = C"
primrec isRepBase :: "base ⇒ bool" where
"isRepBase (Repeats C) = True"
| "isRepBase (Shares C) = False"
primrec isShBase :: "base ⇒ bool" where
"isShBase(Repeats C) = False"
| "isShBase(Shares C) = True"
definition is_refT :: "ty ⇒ bool" where
"is_refT T ≡ T = NT ∨ (∃C. T = Class C)"
lemma [iff]: "is_refT NT"
by(simp add:is_refT_def)
lemma [iff]: "is_refT(Class C)"
by(simp add:is_refT_def)
lemma refTE:
"⟦is_refT T; T = NT ⟹ Q; ⋀C. T = Class C ⟹ Q ⟧ ⟹ Q"
by (auto simp add: is_refT_def)
lemma not_refTE:
"⟦ ¬is_refT T; T = Void ∨ T = Boolean ∨ T = Integer ⟹ Q ⟧ ⟹ Q"
by (cases T, auto simp add: is_refT_def)
type_synonym
env = "vname ⇀ ty"
end
Theory Value
section ‹CoreC++ values›
theory Value imports Type begin
type_synonym addr = nat
type_synonym path = "cname list"
type_synonym reference = "addr × path"
datatype val
= Unit
| Null
| Bool bool
| Intg int
| Ref reference
primrec the_Intg :: "val ⇒ int" where
"the_Intg (Intg i) = i"
primrec the_addr :: "val ⇒ addr" where
"the_addr (Ref r) = fst r"
primrec the_path :: "val ⇒ path" where
"the_path (Ref r) = snd r"
primrec default_val :: "ty ⇒ val" where
"default_val Void = Unit"
| "default_val Boolean = Bool False"
| "default_val Integer = Intg 0"
| "default_val NT = Null"
| "default_val (Class C) = Null"
lemma default_val_no_Ref:"default_val T = Ref(a,Cs) ⟹ False"
by(cases T)simp_all
primrec typeof :: "val ⇒ ty option" where
"typeof Unit = Some Void"
| "typeof Null = Some NT"
| "typeof (Bool b) = Some Boolean"
| "typeof (Intg i) = Some Integer"
| "typeof (Ref r) = None"
lemma [simp]: "(typeof v = Some Boolean) = (∃b. v = Bool b)"
by(induct v) auto
lemma [simp]: "(typeof v = Some Integer) = (∃i. v = Intg i)"
by(cases v) auto
lemma [simp]: "(typeof v = Some NT) = (v = Null)"
by(cases v) auto
lemma [simp]: "(typeof v = Some Void) = (v = Unit)"
by(cases v) auto
end
Theory Expr
section ‹Expressions›
theory Expr imports Value begin
subsection ‹The expressions›
datatype bop = Eq | Add
datatype expr
= new cname
| Cast cname expr
| StatCast cname expr
("⦇_⦈_" [80,81] 80)
| Val val
| BinOp expr bop expr ("_ «_» _" [80,0,81] 80)
| Var vname
| LAss vname expr ("_:=_" [70,70] 70)
| FAcc expr vname path ("_∙_{_}" [10,90,99] 90)
| FAss expr vname path expr ("_∙_{_} := _" [10,70,99,70] 70)
| Call expr "cname option" mname "expr list"
| Block vname ty expr ("'{_:_; _}")
| Seq expr expr ("_;;/ _" [61,60] 60)
| Cond expr expr expr ("if '(_') _/ else _" [80,79,79] 70)
| While expr expr ("while '(_') _" [80,79] 70)
| throw expr
abbreviation (input)
DynCall :: "expr ⇒ mname ⇒ expr list ⇒ expr" ("_∙_'(_')" [90,99,0] 90) where
"e∙M(es) == Call e None M es"
abbreviation (input)
StaticCall :: "expr ⇒ cname ⇒ mname ⇒ expr list ⇒ expr"
("_∙'(_::')_'(_')" [90,99,99,0] 90) where
"e∙(C::)M(es) == Call e (Some C) M es"
text‹The semantics of binary operators:›
fun binop :: "bop × val × val ⇒ val option" where
"binop(Eq,v⇩1,v⇩2) = Some(Bool (v⇩1 = v⇩2))"
| "binop(Add,Intg i⇩1,Intg i⇩2) = Some(Intg(i⇩1+i⇩2))"
| "binop(bop,v⇩1,v⇩2) = None"
lemma [simp]:
"(binop(Add,v⇩1,v⇩2) = Some v) = (∃i⇩1 i⇩2. v⇩1 = Intg i⇩1 ∧ v⇩2 = Intg i⇩2 ∧ v = Intg(i⇩1+i⇩2))"
apply(cases v⇩1)
apply auto
apply(cases v⇩2)
apply auto
done
lemma binop_not_ref[simp]:
"binop(bop,v⇩1,v⇩2) = Some (Ref r) ⟹ False"
by(cases bop)auto
subsection‹Free Variables›
primrec
fv :: "expr ⇒ vname set"
and fvs :: "expr list ⇒ vname set" where
"fv(new C) = {}"
| "fv(Cast C e) = fv e"
| "fv(⦇C⦈e) = fv e"
| "fv(Val v) = {}"
| "fv(e⇩1 «bop» e⇩2) = fv e⇩1 ∪ fv e⇩2"
| "fv(Var V) = {V}"
| "fv(V := e) = {V} ∪ fv e"
| "fv(e∙F{Cs}) = fv e"
| "fv(e⇩1∙F{Cs}:=e⇩2) = fv e⇩1 ∪ fv e⇩2"
| "fv(Call e Copt M es) = fv e ∪ fvs es"
| "fv({V:T; e}) = fv e - {V}"
| "fv(e⇩1;;e⇩2) = fv e⇩1 ∪ fv e⇩2"
| "fv(if (b) e⇩1 else e⇩2) = fv b ∪ fv e⇩1 ∪ fv e⇩2"
| "fv(while (b) e) = fv b ∪ fv e"
| "fv(throw e) = fv e"
| "fvs([]) = {}"
| "fvs(e#es) = fv e ∪ fvs es"
lemma [simp]: "fvs(es⇩1 @ es⇩2) = fvs es⇩1 ∪ fvs es⇩2"
by (induct es⇩1 type:list) auto
lemma [simp]: "fvs(map Val vs) = {}"
by (induct vs) auto
end
Theory Decl
section ‹Class Declarations and Programs›
theory Decl imports Expr begin
type_synonym
fdecl = "vname × ty"
type_synonym
"method" = "ty list × ty × (vname list × expr)"
type_synonym
mdecl = "mname × method"
type_synonym
"class" = "base list × fdecl list × mdecl list"
type_synonym
cdecl = "cname × class"
type_synonym
prog = "cdecl list"
translations
(type) "fdecl" <= (type) "vname × ty"
(type) "mdecl" <= (type) "mname × ty list × ty × (vname list × expr)"
(type) "class" <= (type) "cname × fdecl list × mdecl list"
(type) "cdecl" <= (type) "cname × class"
(type) "prog " <= (type) "cdecl list"
definition "class" :: "prog ⇒ cname ⇀ class" where
"class ≡ map_of"
definition is_class :: "prog ⇒ cname ⇒ bool" where
"is_class P C ≡ class P C ≠ None"
definition baseClasses :: "base list ⇒ cname set" where
"baseClasses Bs ≡ set ((map getbase) Bs)"
definition RepBases :: "base list ⇒ cname set" where
"RepBases Bs ≡ set ((map getbase) (filter isRepBase Bs))"
definition SharedBases :: "base list ⇒ cname set" where
"SharedBases Bs ≡ set ((map getbase) (filter isShBase Bs))"
lemma not_getbase_repeats:
"D ∉ set (map getbase xs) ⟹ Repeats D ∉ set xs"
by (induct rule: list.induct, auto)
lemma not_getbase_shares:
"D ∉ set (map getbase xs) ⟹ Shares D ∉ set xs"
by (induct rule: list.induct, auto)
lemma RepBaseclass_isBaseclass:
"⟦class P C = Some(Bs,fs,ms); Repeats D ∈ set Bs⟧
⟹ D ∈ baseClasses Bs"
by (simp add:baseClasses_def, induct rule: list.induct,
auto simp:not_getbase_repeats)
lemma ShBaseclass_isBaseclass:
"⟦class P C = Some(Bs,fs,ms); Shares D ∈ set Bs⟧
⟹ D ∈ baseClasses Bs"
by (simp add:baseClasses_def, induct rule: list.induct,
auto simp:not_getbase_shares)
lemma base_repeats_or_shares:
"⟦B ∈ set Bs; D = getbase B⟧
⟹ Repeats D ∈ set Bs ∨ Shares D ∈ set Bs"
by(induct B rule:base.induct) simp+
lemma baseClasses_repeats_or_shares:
"D ∈ baseClasses Bs ⟹ Repeats D ∈ set Bs ∨ Shares D ∈ set Bs"
by (auto elim!:bexE base_repeats_or_shares
simp add:baseClasses_def image_def)
lemma finite_is_class: "finite {C. is_class P C}"
apply (unfold is_class_def class_def)
apply (fold dom_def)
apply (rule finite_dom_map_of)
done
lemma finite_baseClasses:
"class P C = Some(Bs,fs,ms) ⟹ finite (baseClasses Bs)"
apply (unfold is_class_def class_def baseClasses_def)
apply clarsimp
done
definition is_type :: "prog ⇒ ty ⇒ bool" where
"is_type P T ≡
(case T of Void ⇒ True | Boolean ⇒ True | Integer ⇒ True | NT ⇒ True
| Class C ⇒ is_class P C)"
lemma is_type_simps [simp]:
"is_type P Void ∧ is_type P Boolean ∧ is_type P Integer ∧
is_type P NT ∧ is_type P (Class C) = is_class P C"
by(simp add:is_type_def)
abbreviation
"types P == Collect (CONST is_type P)"
lemma typeof_lit_is_type:
"typeof v = Some T ⟹ is_type P T"
by (induct v) (auto)
end
Theory ClassRel
section ‹The subclass relation›
theory ClassRel imports Decl begin
inductive_set
subclsR :: "prog ⇒ (cname × cname) set"
and subclsR' :: "prog ⇒ [cname, cname] ⇒ bool" ("_ ⊢ _ ≺⇩R _" [71,71,71] 70)
for P :: prog
where
"P ⊢ C ≺⇩R D ≡ (C,D) ∈ subclsR P"
| subclsRI: "⟦class P C = Some (Bs,rest); Repeats(D) ∈ set Bs⟧ ⟹ P ⊢ C ≺⇩R D"
inductive_set
subclsS :: "prog ⇒ (cname × cname) set"
and subclsS' :: "prog ⇒ [cname, cname] ⇒ bool" ("_ ⊢ _ ≺⇩S _" [71,71,71] 70)
for P :: prog
where
"P ⊢ C ≺⇩S D ≡ (C,D) ∈ subclsS P"
| subclsSI: "⟦class P C = Some (Bs,rest); Shares(D) ∈ set Bs⟧ ⟹ P ⊢ C ≺⇩S D"
inductive_set
subcls1 :: "prog ⇒ (cname × cname) set"
and subcls1' :: "prog ⇒ [cname, cname] ⇒ bool" ("_ ⊢ _ ≺⇧1 _" [71,71,71] 70)
for P :: prog
where
"P ⊢ C ≺⇧1 D ≡ (C,D) ∈ subcls1 P"
| subcls1I: "⟦class P C = Some (Bs,rest); D ∈ baseClasses Bs⟧ ⟹ P ⊢ C ≺⇧1 D"
abbreviation
subcls :: "prog ⇒ [cname, cname] ⇒ bool" ("_ ⊢ _ ≼⇧* _" [71,71,71] 70) where
"P ⊢ C ≼⇧* D ≡ (C,D) ∈ (subcls1 P)⇧*"
lemma subclsRD:
"P ⊢ C ≺⇩R D ⟹ ∃fs ms Bs. (class P C = Some (Bs,fs,ms)) ∧ (Repeats(D) ∈ set Bs)"
by(auto elim: subclsR.cases)
lemma subclsSD:
"P ⊢ C ≺⇩S D ⟹ ∃fs ms Bs. (class P C = Some (Bs,fs,ms)) ∧ (Shares(D) ∈ set Bs)"
by(auto elim: subclsS.cases)
lemma subcls1D:
"P ⊢ C ≺⇧1 D ⟹ ∃fs ms Bs. (class P C = Some (Bs,fs,ms)) ∧ (D ∈ baseClasses Bs)"
by(auto elim: subcls1.cases)
lemma subclsR_subcls1:
"P ⊢ C ≺⇩R D ⟹ P ⊢ C ≺⇧1 D"
by (auto elim!:subclsR.cases intro:subcls1I simp:RepBaseclass_isBaseclass)
lemma subclsS_subcls1:
"P ⊢ C ≺⇩S D ⟹ P ⊢ C ≺⇧1 D"
by (auto elim!:subclsS.cases intro:subcls1I simp:ShBaseclass_isBaseclass)
lemma subcls1_subclsR_or_subclsS:
"P ⊢ C ≺⇧1 D ⟹ P ⊢ C ≺⇩R D ∨ P ⊢ C ≺⇩S D"
by (auto dest!:subcls1D intro:subclsRI
dest:baseClasses_repeats_or_shares subclsSI)
lemma finite_subcls1: "finite (subcls1 P)"
apply(subgoal_tac "subcls1 P = (SIGMA C: {C. is_class P C} .
{D. D ∈ baseClasses (fst(the(class P C)))})")
prefer 2
apply(fastforce simp:is_class_def dest: subcls1D elim: subcls1I)
apply simp
apply(rule finite_SigmaI [OF finite_is_class])
apply(rule_tac B = "baseClasses (fst (the (class P C)))" in finite_subset)
apply (auto intro:finite_baseClasses simp:is_class_def)
done
lemma finite_subclsR: "finite (subclsR P)"
by(rule_tac B = "subcls1 P" in finite_subset,
auto simp:subclsR_subcls1 finite_subcls1)
lemma finite_subclsS: "finite (subclsS P)"
by(rule_tac B = "subcls1 P" in finite_subset,
auto simp:subclsS_subcls1 finite_subcls1)
lemma subcls1_class:
"P ⊢ C ≺⇧1 D ⟹ is_class P C"
by (auto dest:subcls1D simp:is_class_def)
lemma subcls_is_class:
"⟦P ⊢ D ≼⇧* C; is_class P C⟧ ⟹ is_class P D"
by (induct rule:rtrancl_induct,auto dest:subcls1_class)
end
Theory SubObj
section ‹Definition of Subobjects›
theory SubObj
imports ClassRel
begin
subsection ‹General definitions›
type_synonym
subobj = "cname × path"
definition mdc :: "subobj ⇒ cname" where
"mdc S = fst S"
definition ldc :: "subobj ⇒ cname" where
"ldc S = last (snd S)"
lemma mdc_tuple [simp]: "mdc (C,Cs) = C"
by(simp add:mdc_def)
lemma ldc_tuple [simp]: "ldc (C,Cs) = last Cs"
by(simp add:ldc_def)
subsection ‹Subobjects according to Rossie-Friedman›
fun is_subobj :: "prog ⇒ subobj ⇒ bool" where
"is_subobj P (C, []) ⟷ False"
| "is_subobj P (C, [D]) ⟷ (is_class P C ∧ C = D)
∨ (∃ X. P ⊢ C ≼⇧* X ∧ P ⊢ X ≺⇩S D)"
| "is_subobj P (C, D # E # Xs) = (let Ys=butlast (D # E # Xs);
Y=last (D # E # Xs);
X=last Ys
in is_subobj P (C, Ys) ∧ P ⊢ X ≺⇩R Y)"
lemma subobj_aux_rev:
assumes 1:"is_subobj P ((C,C'#rev Cs@[C'']))"
shows "is_subobj P ((C,C'#rev Cs))"
proof -
obtain Cs' where Cs':"Cs' = rev Cs" by simp
hence rev:"Cs'@[C''] = rev Cs@[C'']" by simp
from this obtain D Ds where DDs:"Cs'@[C''] = D#Ds" by (cases Cs') auto
with 1 rev have subo:"is_subobj P ((C,C'#D#Ds))" by simp
from DDs have "butlast (C'#D#Ds) = C'#Cs'" by (cases Cs') auto
with subo have "is_subobj P ((C,C'#Cs'))" by simp
with Cs' show ?thesis by simp
qed
lemma subobj_aux:
assumes 1:"is_subobj P ((C,C'#Cs@[C'']))"
shows "is_subobj P ((C,C'#Cs))"
proof -
from 1 obtain Cs' where Cs':"Cs' = rev Cs" by simp
with 1 have "is_subobj P ((C,C'#rev Cs'@[C'']))" by simp
hence "is_subobj P ((C,C'#rev Cs'))" by (rule subobj_aux_rev)
with Cs' show ?thesis by simp
qed
lemma isSubobj_isClass:
assumes 1:"is_subobj P (R)"
shows "is_class P (mdc R)"
proof -
obtain C' Cs' where R:"R = (C',Cs')" by(cases R) auto
with 1 have ne:"Cs' ≠ []" by (cases Cs') auto
from this obtain C'' Cs'' where C''Cs'':"Cs' = C''#Cs''" by (cases Cs') auto
from this obtain Ds where "Ds = rev Cs''" by simp
with 1 R C''Cs'' have subo1:"is_subobj P ((C',C''#rev Ds))" by simp
with R show ?thesis
by (induct Ds,auto simp:mdc_def split:if_split_asm dest:subobj_aux,
auto elim:converse_rtranclE dest!:subclsS_subcls1 elim:subcls1_class)
qed
lemma isSubobjs_subclsR_rev:
assumes 1:"is_subobj P ((C,Cs@[D,D']@(rev Cs')))"
shows "P ⊢ D ≺⇩R D'"
using 1
proof (induct Cs')
case Nil
from this obtain Cs' X Y Xs where Cs'1:"Cs' = Cs@[D,D']"
and "X = hd(Cs@[D,D'])" and "Y = hd(tl(Cs@[D,D']))"
and "Xs = tl(tl(Cs@[D,D']))" by simp
hence Cs'2:"Cs' = X#Y#Xs" by (cases Cs) auto
from Cs'1 have last:"last Cs' = D'" by simp
from Cs'1 have butlast:"last(butlast Cs') = D" by (simp add:butlast_tail)
from Nil Cs'1 Cs'2 have "is_subobj P ((C,X#Y#Xs))" by simp
with last butlast Cs'2 show ?case by simp
next
case (Cons C'' Cs'')
have IH:"is_subobj P ( (C, Cs @ [D, D'] @ rev Cs'')) ⟹ P ⊢ D ≺⇩R D'" by fact
from Cons obtain Cs' X Y Xs where Cs'1:"Cs' = Cs@[D,D']@(rev (C''#Cs''))"
and "X = hd(Cs@[D,D']@(rev (C''#Cs'')))"
and "Y = hd(tl(Cs@[D,D']@(rev (C''#Cs''))))"
and "Xs = tl(tl(Cs@[D,D']@(rev (C''#Cs''))))" by simp
hence Cs'2:"Cs' = X#Y#Xs" by (cases Cs) auto
from Cons Cs'1 Cs'2 have "is_subobj P ((C,X#Y#Xs))" by simp
hence sub:"is_subobj P ((C,butlast (X#Y#Xs)))" by simp
from Cs'1 obtain E Es where Cs'3:"Cs' = Es@[E]" by (cases Cs') auto
with Cs'1 have butlast:"Es = Cs@[D,D']@(rev Cs'')" by simp
from Cs'3 have "butlast Cs' = Es" by simp
with butlast have "butlast Cs' = Cs@[D,D']@(rev Cs'')" by simp
with Cs'2 sub have "is_subobj P ((C,Cs@[D,D']@(rev Cs'')))"
by simp
with IH show ?case by simp
qed
lemma isSubobjs_subclsR:
assumes 1:"is_subobj P ((C,Cs@[D,D']@Cs'))"
shows "P ⊢ D ≺⇩R D'"
proof -
from 1 obtain Cs'' where "Cs'' = rev Cs'" by simp
with 1 have "is_subobj P ((C,Cs@[D,D']@(rev Cs'')))" by simp
thus ?thesis by (rule isSubobjs_subclsR_rev)
qed
lemma mdc_leq_ldc_aux:
assumes 1:"is_subobj P ((C,C'#rev Cs'))"
shows "P ⊢ C ≼⇧* last (C'#rev Cs')"
using 1
proof (induct Cs')
case Nil
from 1 have "is_class P C"
by (drule_tac R="(C,C'#rev Cs')" in isSubobj_isClass, simp add:mdc_def)
with Nil show ?case
proof (cases "C=C'")
case True
thus ?thesis by simp
next
case False
with Nil show ?thesis
by (auto dest!:subclsS_subcls1)
qed
next
case (Cons C'' Cs'')
have IH:"is_subobj P ( (C, C' # rev Cs'')) ⟹ P ⊢ C ≼⇧* last (C' # rev Cs'')"
and subo:"is_subobj P ( (C, C' # rev (C'' # Cs'')))" by fact+
hence "is_subobj P ( (C, C' # rev Cs''))" by (simp add:subobj_aux_rev)
with IH have rel:"P ⊢ C ≼⇧* last (C' # rev Cs'')" by simp
from subo obtain D Ds where DDs:"C' # rev Cs'' = Ds@[D]"
by (cases Cs'') auto
hence " C' # rev (C'' # Cs'') = Ds@[D,C'']" by simp
with subo have "is_subobj P ((C,Ds@[D,C'']))" by (cases Ds) auto
hence "P ⊢ D ≺⇩R C''" by (rule_tac Cs'="[]" in isSubobjs_subclsR) simp
hence rel1:"P ⊢ D ≺⇧1 C''" by (rule subclsR_subcls1)
from DDs have "D = last (C' # rev Cs'')" by simp
with rel1 have lastrel1:"P ⊢ last (C' # rev Cs'') ≺⇧1 C''" by simp
with rel have "P ⊢ C ≼⇧* C''"
by(rule_tac b="last (C' # rev Cs'')" in rtrancl_into_rtrancl) simp
thus ?case by simp
qed
lemma mdc_leq_ldc:
assumes 1:"is_subobj P (R)"
shows "P ⊢ mdc R ≼⇧* ldc R"
proof -
from 1 obtain C Cs where R:"R = (C,Cs)" by (cases R) auto
with 1 have ne:"Cs ≠ []" by (cases Cs) auto
from this obtain C' Cs' where Cs:"Cs = C'#Cs'" by (cases Cs) auto
from this obtain Cs'' where Cs':"Cs'' = rev Cs'" by simp
with R Cs 1 have "is_subobj P ((C,C'#rev Cs''))" by simp
hence rel:"P ⊢ C ≼⇧* last (C'#rev Cs'')" by (rule mdc_leq_ldc_aux)
from R Cs Cs' have ldc:"last (C'#rev Cs'') = ldc R" by(simp add:ldc_def)
from R have "mdc R = C" by(simp add:mdc_def)
with ldc rel show ?thesis by simp
qed
text‹Next three lemmas show subobject property as presented in literature›
lemma class_isSubobj:
"is_class P C ⟹ is_subobj P ((C,[C]))"
by simp
lemma repSubobj_isSubobj:
assumes 1:"is_subobj P ((C,Xs@[X]))" and 2:"P ⊢ X ≺⇩R Y"
shows "is_subobj P ((C,Xs@[X,Y]))"
using 1
proof -
obtain Cs D E Cs' where Cs1:"Cs = Xs@[X,Y]" and "D = hd(Xs@[X,Y])"
and "E = hd(tl(Xs@[X,Y]))" and "Cs' = tl(tl(Xs@[X,Y]))"by simp
hence Cs2:"Cs = D#E#Cs'" by (cases Xs) auto
with 1 Cs1 have subobj_butlast:"is_subobj P ((C,butlast(D#E#Cs')))"
by (simp add:butlast_tail)
with 2 Cs1 Cs2 have "P ⊢ (last(butlast(D#E#Cs'))) ≺⇩R last(D#E#Cs')"
by (simp add:butlast_tail)
with subobj_butlast have "is_subobj P ((C,(D#E#Cs')))" by simp
with Cs1 Cs2 show ?thesis by simp
qed
lemma shSubobj_isSubobj:
assumes 1: "is_subobj P ((C,Xs@[X]))" and 2:"P ⊢ X ≺⇩S Y"
shows "is_subobj P ((C,[Y]))"
using 1
proof -
from 1 have classC:"is_class P C"
by (drule_tac R="(C,Xs@[X])" in isSubobj_isClass, simp add:mdc_def)
from 1 have "P ⊢ C ≼⇧* X"
by (drule_tac R="(C,Xs@[X])" in mdc_leq_ldc, simp add:mdc_def ldc_def)
with classC 2 show ?thesis by fastforce
qed
text‹Auxiliary lemmas›
lemma build_rec_isSubobj_rev:
assumes 1:"is_subobj P ((D,D#rev Cs))" and 2:" P ⊢ C ≺⇩R D"
shows "is_subobj P ((C,C#D#rev Cs))"
using 1
proof (induct Cs)
case Nil
from 2 have "is_class P C" by (auto dest:subclsRD simp add:is_class_def)
with 1 2 show ?case by simp
next
case (Cons C' Cs')
have suboD:"is_subobj P ((D,D#rev (C'#Cs')))"
and IH:"is_subobj P ((D,D#rev Cs')) ⟹ is_subobj P ((C,C#D#rev Cs'))" by fact+
obtain E Es where E:"E = hd (rev (C'#Cs'))" and Es:"Es = tl (rev (C'#Cs'))"
by simp
with E have E_Es:"rev (C'#Cs') = E#Es" by simp
with E Es have butlast:"butlast (D#E#Es) = D#rev Cs'" by simp
from E_Es suboD have suboDE:"is_subobj P ((D,D#E#Es))" by simp
hence "is_subobj P ((D,butlast (D#E#Es)))" by simp
with butlast have "is_subobj P ((D,D#rev Cs'))" by simp
with IH have suboCD:"is_subobj P ( (C, C#D#rev Cs'))" by simp
from suboDE obtain Xs X Y Xs' where Xs':"Xs' = D#E#Es"
and bb:"Xs = butlast (butlast (D#E#Es))"
and lb:"X = last(butlast (D#E#Es))" and l:"Y = last (D#E#Es)" by simp
from this obtain Xs'' where Xs'':"Xs'' = Xs@[X]" by simp
with bb lb have "Xs'' = butlast (D#E#Es)" by simp
with l have "D#E#Es = Xs''@[Y]" by simp
with Xs'' have "D#E#Es = Xs@[X]@[Y]" by simp
with suboDE have "is_subobj P ((D,Xs@[X,Y]))" by simp
hence subR:"P ⊢ X ≺⇩R Y" by(rule_tac Cs="Xs" and Cs'="[]" in isSubobjs_subclsR) simp
from E_Es Es have "last (D#E#Es) = C'" by simp
with subR lb l butlast have "P ⊢ last(D#rev Cs') ≺⇩R C'"
by (auto split:if_split_asm)
with suboCD show ?case by simp
qed
lemma build_rec_isSubobj:
assumes 1:"is_subobj P ((D,D#Cs))" and 2:" P ⊢ C ≺⇩R D"
shows "is_subobj P ((C,C#D#Cs))"
proof -
obtain Cs' where Cs':"Cs' = rev Cs" by simp
with 1 have "is_subobj P ((D,D#rev Cs'))" by simp
with 2 have "is_subobj P ((C,C#D#rev Cs'))"
by - (rule build_rec_isSubobj_rev)
with Cs' show ?thesis by simp
qed
lemma isSubobj_isSubobj_isSubobj_rev:
assumes 1:"is_subobj P ((C,[D]))" and 2:"is_subobj P ((D,D#(rev Cs)))"
shows "is_subobj P ((C,D#(rev Cs)))"
using 2
proof (induct Cs)
case Nil
with 1 show ?case by simp
next
case (Cons C' Cs')
have IH:"is_subobj P ((D,D#rev Cs')) ⟹ is_subobj P ((C,D#rev Cs'))"
and "is_subobj P ((D,D#rev (C'#Cs')))" by fact+
hence suboD:"is_subobj P ((D,D#rev Cs'@[C']))" by simp
hence "is_subobj P ((D,D#rev Cs'))" by (rule subobj_aux_rev)
with IH have suboC:"is_subobj P ((C,D#rev Cs'))" by simp
obtain C'' where C'': "C'' = last (D # rev Cs')" by simp
moreover have "D # rev Cs' = butlast (D # rev Cs') @ [last (D # rev Cs')]"
by (rule append_butlast_last_id [symmetric]) simp
ultimately have butlast: "D # rev Cs' = butlast (D #rev Cs') @ [C'']"
by simp
hence butlast2:"D#rev Cs'@[C'] = butlast(D#rev Cs')@[C'']@[C']" by simp
with suboD have "is_subobj P ((D,butlast(D#rev Cs')@[C'']@[C']))"
by simp
with C'' have subR:"P ⊢ C'' ≺⇩R C'"
by (rule_tac Cs="butlast(D#rev Cs')" and Cs'="[]" in isSubobjs_subclsR)simp
with C'' suboC butlast have "is_subobj P ((C,butlast(D#rev Cs')@[C'']@[C']))"
by (auto intro:repSubobj_isSubobj simp del:butlast.simps)
with butlast2 have "is_subobj P ((C,D#rev Cs'@[C']))"
by (cases Cs')auto
thus ?case by simp
qed
lemma isSubobj_isSubobj_isSubobj:
assumes 1:"is_subobj P ((C,[D]))" and 2:"is_subobj P ((D,D#Cs))"
shows "is_subobj P ((C,D#Cs))"
proof -
obtain Cs' where Cs':"Cs' = rev Cs" by simp
with 2 have "is_subobj P ((D,D#rev Cs'))" by simp
with 1 have "is_subobj P ((C,D#rev Cs'))"
by - (rule isSubobj_isSubobj_isSubobj_rev)
with Cs' show ?thesis by simp
qed
subsection ‹Subobject handling and lemmas›
text‹Subobjects consisting of repeated inheritance relations only:›
inductive Subobjs⇩R :: "prog ⇒ cname ⇒ path ⇒ bool" for P :: prog
where
SubobjsR_Base: "is_class P C ⟹ Subobjs⇩R P C [C]"
| SubobjsR_Rep: "⟦P ⊢ C ≺⇩R D; Subobjs⇩R P D Cs⟧ ⟹ Subobjs⇩R P C (C # Cs)"
text‹All subobjects:›
inductive Subobjs :: "prog ⇒ cname ⇒ path ⇒ bool" for P :: prog
where
Subobjs_Rep: "Subobjs⇩R P C Cs ⟹ Subobjs P C Cs"
| Subobjs_Sh: "⟦P ⊢ C ≼⇧* C'; P ⊢ C' ≺⇩S D; Subobjs⇩R P D Cs⟧
⟹ Subobjs P C Cs"
lemma Subobjs_Base:"is_class P C ⟹ Subobjs P C [C]"
by (fastforce intro:Subobjs_Rep SubobjsR_Base)
lemma SubobjsR_nonempty: "Subobjs⇩R P C Cs ⟹ Cs ≠ []"
by (induct rule: Subobjs⇩R.induct, simp_all)
lemma Subobjs_nonempty: "Subobjs P C Cs ⟹ Cs ≠ []"
by (erule Subobjs.induct)(erule SubobjsR_nonempty)+
lemma hd_SubobjsR:
"Subobjs⇩R P C Cs ⟹ ∃Cs'. Cs = C#Cs'"
by(erule Subobjs⇩R.induct,simp+)
lemma SubobjsR_subclassRep:
"Subobjs⇩R P C Cs ⟹ (C,last Cs) ∈ (subclsR P)⇧*"
apply(erule Subobjs⇩R.induct)
apply simp
apply(simp add: SubobjsR_nonempty)
done
lemma SubobjsR_subclass: "Subobjs⇩R P C Cs ⟹ P ⊢ C ≼⇧* last Cs"
apply(erule Subobjs⇩R.induct)
apply simp
apply(simp add: SubobjsR_nonempty)
apply(blast intro:subclsR_subcls1 rtrancl_trans)
done
lemma Subobjs_subclass: "Subobjs P C Cs ⟹ P ⊢ C ≼⇧* last Cs"
apply(erule Subobjs.induct)
apply(erule SubobjsR_subclass)
apply(erule rtrancl_trans)
apply(blast intro:subclsS_subcls1 SubobjsR_subclass rtrancl_trans)
done
lemma Subobjs_notSubobjsR:
"⟦Subobjs P C Cs; ¬ Subobjs⇩R P C Cs⟧
⟹ ∃C' D. P ⊢ C ≼⇧* C' ∧ P ⊢ C' ≺⇩S D ∧ Subobjs⇩R P D Cs"
apply (induct rule: Subobjs.induct)
apply clarsimp
apply fastforce
done
lemma assumes subo:"Subobjs⇩R P (hd (Cs@ C'#Cs')) (Cs@ C'#Cs')"
shows SubobjsR_Subobjs:"Subobjs P C' (C'#Cs')"
using subo
proof (induct Cs)
case Nil
thus ?case by -(frule hd_SubobjsR,fastforce intro:Subobjs_Rep)
next
case (Cons D Ds)
have subo':"Subobjs⇩R P (hd ((D#Ds) @ C'#Cs')) ((D#Ds) @ C'#Cs')"
and IH:"Subobjs⇩R P (hd (Ds @ C'#Cs')) (Ds @ C'#Cs') ⟹ Subobjs P C' (C'#Cs')" by fact+
from subo' have "Subobjs⇩R P (hd (Ds @ C' # Cs')) (Ds @ C' # Cs')"
apply -
apply (drule Subobjs⇩R.cases)
apply auto
apply (rename_tac D')
apply (subgoal_tac "D' = hd (Ds @ C' # Cs')")
apply (auto dest:hd_SubobjsR)
done
with IH show ?case by simp
qed
lemma Subobjs_Subobjs:"Subobjs P C (Cs@ C'#Cs') ⟹ Subobjs P C' (C'#Cs')"
apply -
apply (drule Subobjs.cases)
apply auto
apply (subgoal_tac "C = hd(Cs @ C' # Cs')")
apply (fastforce intro:SubobjsR_Subobjs)
apply (fastforce dest:hd_SubobjsR)
apply (subgoal_tac "D = hd(Cs @ C' # Cs')")
apply (fastforce intro:SubobjsR_Subobjs)
apply (fastforce dest:hd_SubobjsR)
done
lemma SubobjsR_isClass:
assumes subo:"Subobjs⇩R P C Cs"
shows "is_class P C"
using subo
proof (induct rule:Subobjs⇩R.induct)
case SubobjsR_Base thus ?case by assumption
next
case SubobjsR_Rep thus ?case by (fastforce intro:subclsR_subcls1 subcls1_class)
qed
lemma Subobjs_isClass:
assumes subo:"Subobjs P C Cs"
shows "is_class P C"
using subo
proof (induct rule:Subobjs.induct)
case Subobjs_Rep thus ?case by (rule SubobjsR_isClass)
next
case (Subobjs_Sh C C' D Cs)
have leq:"P ⊢ C ≼⇧* C'" and leqS:"P ⊢ C' ≺⇩S D" by fact+
hence "(C,D) ∈ (subcls1 P)⇧+" by (fastforce intro:rtrancl_into_trancl1 subclsS_subcls1)
thus ?case by (induct rule:trancl_induct, fastforce intro:subcls1_class)
qed
lemma Subobjs_subclsR:
assumes subo:"Subobjs P C (Cs@[D,D']@Cs')"
shows "P ⊢ D ≺⇩R D'"
using subo
proof -
from subo have "Subobjs P D (D#D'#Cs')" by -(rule Subobjs_Subobjs,simp)
then obtain C' where subo':"Subobjs⇩R P C' (D#D'#Cs')"
by (induct rule:Subobjs.induct,blast+)
hence "C' = D" by -(drule hd_SubobjsR,simp)
with subo' have "Subobjs⇩R P D (D#D'#Cs')" by simp
thus ?thesis by (fastforce elim:Subobjs⇩R.cases dest:hd_SubobjsR)
qed
lemma assumes subo:"Subobjs⇩R P (hd Cs) (Cs@[D])" and notempty:"Cs ≠ []"
shows butlast_Subobjs_Rep:"Subobjs⇩R P (hd Cs) Cs"
using subo notempty
proof (induct Cs)
case Nil thus ?case by simp
next
case (Cons C' Cs')
have subo:"Subobjs⇩R P (hd(C'#Cs')) ((C'#Cs')@[D])"
and IH:"⟦Subobjs⇩R P (hd Cs') (Cs'@[D]); Cs' ≠ []⟧ ⟹ Subobjs⇩R P (hd Cs') Cs'" by fact+
from subo have subo':"Subobjs⇩R P C' (C'#Cs'@[D])" by simp
show ?case
proof (cases "Cs' = []")
case True
with subo' have "Subobjs⇩R P C' [C',D]" by simp
hence "is_class P C'" by(rule SubobjsR_isClass)
hence "Subobjs⇩R P C' [C']" by (rule SubobjsR_Base)
with True show ?thesis by simp
next
case False
with subo' obtain D' where subo'':"Subobjs⇩R P D' (Cs'@[D])"
and subR:"P ⊢ C' ≺⇩R D'"
by (auto elim:Subobjs⇩R.cases)
from False subo'' have hd:"D' = hd Cs'"
by (induct Cs',auto dest:hd_SubobjsR)
with subo'' False IH have "Subobjs⇩R P (hd Cs') Cs'" by simp
with subR hd have "Subobjs⇩R P C' (C'#Cs')" by (fastforce intro:SubobjsR_Rep)
thus ?thesis by simp
qed
qed
lemma assumes subo:"Subobjs P C (Cs@[D])" and notempty:"Cs ≠ []"
shows butlast_Subobjs:"Subobjs P C Cs"
using subo
proof (rule Subobjs.cases,auto)
assume suboR:"Subobjs⇩R P C (Cs@[D])" and "Subobjs P C (Cs@[D])"
from suboR notempty have hd:"C = hd Cs"
by (induct Cs,auto dest:hd_SubobjsR)
with suboR notempty have "Subobjs⇩R P (hd Cs) Cs"
by(fastforce intro:butlast_Subobjs_Rep)
with hd show "Subobjs P C Cs" by (fastforce intro:Subobjs_Rep)
next
fix C' D' assume leq:"P ⊢ C ≼⇧* C'" and subS:"P ⊢ C' ≺⇩S D'"
and suboR:"Subobjs⇩R P D' (Cs@[D])" and "Subobjs P C (Cs@[D])"
from suboR notempty have hd:"D' = hd Cs"
by (induct Cs,auto dest:hd_SubobjsR)
with suboR notempty have "Subobjs⇩R P (hd Cs) Cs"
by(fastforce intro:butlast_Subobjs_Rep)
with hd leq subS show "Subobjs P C Cs"
by(fastforce intro:Subobjs_Sh)
qed
lemma assumes subo:"Subobjs P C (Cs@(rev Cs'))" and notempty:"Cs ≠ []"
shows rev_appendSubobj:"Subobjs P C Cs"
using subo
proof(induct Cs')
case Nil thus ?case by simp
next
case (Cons D Ds)
have subo':"Subobjs P C (Cs@rev(D#Ds))"
and IH:"Subobjs P C (Cs@rev Ds) ⟹ Subobjs P C Cs" by fact+
from notempty subo' have "Subobjs P C (Cs@rev Ds)"
by (fastforce intro:butlast_Subobjs)
with IH show ?case by simp
qed
lemma appendSubobj:
assumes subo:"Subobjs P C (Cs@Cs')" and notempty:"Cs ≠ []"
shows "Subobjs P C Cs"
proof -
obtain Cs'' where Cs'':"Cs'' = rev Cs'" by simp
with subo have "Subobjs P C (Cs@(rev Cs''))" by simp
with notempty show ?thesis by - (rule rev_appendSubobj)
qed
lemma SubobjsR_isSubobj:
"Subobjs⇩R P C Cs ⟹ is_subobj P ((C,Cs))"
by(erule Subobjs⇩R.induct,simp,
auto dest:hd_SubobjsR intro:build_rec_isSubobj)
lemma leq_SubobjsR_isSubobj:
"⟦P ⊢ C ≼⇧* C'; P ⊢ C' ≺⇩S D; Subobjs⇩R P D Cs⟧
⟹ is_subobj P ((C,Cs))"
apply (subgoal_tac "is_subobj P ((C,[D]))")
apply (frule hd_SubobjsR)
apply (drule SubobjsR_isSubobj)
apply (erule exE)
apply (simp del: is_subobj.simps)
apply (erule isSubobj_isSubobj_isSubobj)
apply simp
apply auto
done
lemma Subobjs_isSubobj:
"Subobjs P C Cs ⟹ is_subobj P ((C,Cs))"
by (auto elim:Subobjs.induct SubobjsR_isSubobj
simp add:leq_SubobjsR_isSubobj)
subsection ‹Paths›
subsection ‹Appending paths›
text‹Avoided name clash by calling one path Path.›
definition path_via :: "prog ⇒ cname ⇒ cname ⇒ path ⇒ bool" ("_ ⊢ Path _ to _ via _ " [51,51,51,51] 50) where
"P ⊢ Path C to D via Cs ≡ Subobjs P C Cs ∧ last Cs = D"
definition path_unique :: "prog ⇒ cname ⇒ cname ⇒ bool" ("_ ⊢ Path _ to _ unique" [51,51,51] 50) where
"P ⊢ Path C to D unique ≡ ∃!Cs. Subobjs P C Cs ∧ last Cs = D"
definition appendPath :: "path ⇒ path ⇒ path" (infixr "@⇩p" 65) where
"Cs @⇩p Cs' ≡ if (last Cs = hd Cs') then Cs @ (tl Cs') else Cs'"
lemma appendPath_last: "Cs ≠ [] ⟹ last Cs = last (Cs'@⇩pCs)"
by(auto simp:appendPath_def last_append)(cases Cs, simp_all)+
inductive
casts_to :: "prog ⇒ ty ⇒ val ⇒ val ⇒ bool"
("_ ⊢ _ casts _ to _ " [51,51,51,51] 50)
for P :: prog
where
casts_prim: "∀C. T ≠ Class C ⟹ P ⊢ T casts v to v"
| casts_null: "P ⊢ Class C casts Null to Null"
| casts_ref: "⟦ P ⊢ Path last Cs to C via Cs'; Ds = Cs@⇩pCs' ⟧
⟹ P ⊢ Class C casts Ref(a,Cs) to Ref(a,Ds)"
inductive
Casts_to :: "prog ⇒ ty list ⇒ val list ⇒ val list ⇒ bool"
("_ ⊢ _ Casts _ to _ " [51,51,51,51] 50)
for P :: prog
where
Casts_Nil: "P ⊢ [] Casts [] to []"
| Casts_Cons: "⟦ P ⊢ T casts v to v'; P ⊢ Ts Casts vs to vs' ⟧
⟹ P ⊢ (T#Ts) Casts (v#vs) to (v'#vs')"
lemma length_Casts_vs:
"P ⊢ Ts Casts vs to vs' ⟹ length Ts = length vs"
by (induct rule:Casts_to.induct,simp_all)
lemma length_Casts_vs':
"P ⊢ Ts Casts vs to vs' ⟹ length Ts = length vs'"
by (induct rule:Casts_to.induct,simp_all)
subsection ‹The relation on paths›
inductive_set
leq_path1 :: "prog ⇒ cname ⇒ (path × path) set"
and leq_path1' :: "prog ⇒ cname ⇒ [path, path] ⇒ bool" ("_,_ ⊢ _ ⊏⇧1 _" [71,71,71] 70)
for P :: prog and C :: cname
where
"P,C ⊢ Cs ⊏⇧1 Ds ≡ (Cs,Ds) ∈ leq_path1 P C"
| leq_pathRep: "⟦ Subobjs P C Cs; Subobjs P C Ds; Cs = butlast Ds⟧
⟹ P,C ⊢ Cs ⊏⇧1 Ds"
| leq_pathSh: "⟦ Subobjs P C Cs; P ⊢ last Cs ≺⇩S D ⟧
⟹ P,C ⊢ Cs ⊏⇧1 [D]"
abbreviation
leq_path :: "prog ⇒ cname ⇒ [path, path] ⇒ bool" ("_,_ ⊢ _ ⊑ _" [71,71,71] 70) where
"P,C ⊢ Cs ⊑ Ds ≡ (Cs,Ds) ∈ (leq_path1 P C)⇧*"
lemma leq_path_rep:
"⟦ Subobjs P C (Cs@[C']); Subobjs P C (Cs@[C',C''])⟧
⟹ P,C ⊢ (Cs@[C']) ⊏⇧1 (Cs@[C',C''])"
by(rule leq_pathRep,simp_all add:butlast_tail)
lemma leq_path_sh:
"⟦ Subobjs P C (Cs@[C']); P ⊢ C' ≺⇩S C''⟧
⟹ P,C ⊢ (Cs@[C']) ⊏⇧1 [C'']"
by(erule leq_pathSh)simp
subsection‹Member lookups›
definition FieldDecls :: "prog ⇒ cname ⇒ vname ⇒ (path × ty) set" where
"FieldDecls P C F ≡
{(Cs,T). Subobjs P C Cs ∧ (∃Bs fs ms. class P (last Cs) = Some(Bs,fs,ms)
∧ map_of fs F = Some T)}"
definition LeastFieldDecl :: "prog ⇒ cname ⇒ vname ⇒ ty ⇒ path ⇒ bool"
("_ ⊢ _ has least _:_ via _" [51,0,0,0,51] 50) where
"P ⊢ C has least F:T via Cs ≡
(Cs,T) ∈ FieldDecls P C F ∧
(∀(Cs',T') ∈ FieldDecls P C F. P,C ⊢ Cs ⊑ Cs')"
definition MethodDefs :: "prog ⇒ cname ⇒ mname ⇒ (path × method)set" where
"MethodDefs P C M ≡
{(Cs,mthd). Subobjs P C Cs ∧ (∃Bs fs ms. class P (last Cs) = Some(Bs,fs,ms)
∧ map_of ms M = Some mthd)}"
definition HasMethodDef :: "prog ⇒ cname ⇒ mname ⇒ method ⇒ path ⇒ bool"
("_ ⊢ _ has _ = _ via _" [51,0,0,0,51] 50) where
"P ⊢ C has M = mthd via Cs ≡ (Cs,mthd) ∈ MethodDefs P C M"
definition LeastMethodDef :: "prog ⇒ cname ⇒ mname ⇒ method ⇒ path ⇒ bool"
("_ ⊢ _ has least _ = _ via _" [51,0,0,0,51] 50) where
"P ⊢ C has least M = mthd via Cs ≡
(Cs,mthd) ∈ MethodDefs P C M ∧
(∀(Cs',mthd') ∈ MethodDefs P C M. P,C ⊢ Cs ⊑ Cs')"
definition MinimalMethodDefs :: "prog ⇒ cname ⇒ mname ⇒ (path × method)set" where
"MinimalMethodDefs P C M ≡
{(Cs,mthd). (Cs,mthd) ∈ MethodDefs P C M ∧
(∀(Cs',mthd')∈ MethodDefs P C M. P,C ⊢ Cs' ⊑ Cs ⟶ Cs' = Cs)}"
definition OverriderMethodDefs :: "prog ⇒ subobj ⇒ mname ⇒ (path × method)set" where
"OverriderMethodDefs P R M ≡
{(Cs,mthd). ∃Cs' mthd'. P ⊢ (ldc R) has least M = mthd' via Cs' ∧
(Cs,mthd) ∈ MinimalMethodDefs P (mdc R) M ∧
P,mdc R ⊢ Cs ⊑ (snd R)@⇩pCs'}"
definition FinalOverriderMethodDef :: "prog ⇒ subobj ⇒ mname ⇒ method ⇒ path ⇒ bool"
("_ ⊢ _ has overrider _ = _ via _" [51,0,0,0,51] 50) where
"P ⊢ R has overrider M = mthd via Cs ≡
(Cs,mthd) ∈ OverriderMethodDefs P R M ∧
card(OverriderMethodDefs P R M) = 1"
inductive
SelectMethodDef :: "prog ⇒ cname ⇒ path ⇒ mname ⇒ method ⇒ path ⇒ bool"
("_ ⊢ '(_,_') selects _ = _ via _" [51,0,0,0,0,51] 50)
for P :: prog
where
dyn_unique:
"P ⊢ C has least M = mthd via Cs' ⟹ P ⊢ (C,Cs) selects M = mthd via Cs'"
| dyn_ambiguous:
"⟦∀mthd Cs'. ¬ P ⊢ C has least M = mthd via Cs';
P ⊢ (C,Cs) has overrider M = mthd via Cs'⟧
⟹ P ⊢ (C,Cs) selects M = mthd via Cs'"
lemma sees_fields_fun:
"(Cs,T) ∈ FieldDecls P C F ⟹ (Cs,T') ∈ FieldDecls P C F ⟹ T = T'"
by(fastforce simp:FieldDecls_def)
lemma sees_field_fun:
"⟦P ⊢ C has least F:T via Cs; P ⊢ C has least F:T' via Cs⟧
⟹ T = T'"
by (fastforce simp:LeastFieldDecl_def dest:sees_fields_fun)
lemma has_least_method_has_method:
"P ⊢ C has least M = mthd via Cs ⟹ P ⊢ C has M = mthd via Cs"
by (simp add:LeastMethodDef_def HasMethodDef_def)
lemma visible_methods_exist:
"(Cs,mthd) ∈ MethodDefs P C M ⟹
(∃Bs fs ms. class P (last Cs) = Some(Bs,fs,ms) ∧ map_of ms M = Some mthd)"
by(auto simp:MethodDefs_def)
lemma sees_methods_fun:
"(Cs,mthd) ∈ MethodDefs P C M ⟹ (Cs,mthd') ∈ MethodDefs P C M ⟹ mthd = mthd'"
by(fastforce simp:MethodDefs_def)
lemma sees_method_fun:
"⟦P ⊢ C has least M = mthd via Cs; P ⊢ C has least M = mthd' via Cs⟧
⟹ mthd = mthd'"
by (fastforce simp:LeastMethodDef_def dest:sees_methods_fun)
lemma overrider_method_fun:
assumes overrider:"P ⊢ (C,Cs) has overrider M = mthd via Cs'"
and overrider':"P ⊢ (C,Cs) has overrider M = mthd' via Cs''"
shows "mthd = mthd' ∧ Cs' = Cs''"
proof -
from overrider' have omd:"(Cs'',mthd') ∈ OverriderMethodDefs P (C,Cs) M"
by(simp_all add:FinalOverriderMethodDef_def)
from overrider have "(Cs',mthd) ∈ OverriderMethodDefs P (C,Cs) M"
and "card(OverriderMethodDefs P (C,Cs) M) = 1"
by(simp_all add:FinalOverriderMethodDef_def)
hence "∀(Ds,mthd'') ∈ OverriderMethodDefs P (C,Cs) M. (Cs',mthd) = (Ds,mthd'')"
by(fastforce simp:card_Suc_eq)
with omd show ?thesis by fastforce
qed
end
Theory Objects
section ‹Objects and the Heap›
theory Objects imports SubObj begin
subsection‹Objects›
type_synonym
subo = "(path × (vname ⇀ val))"
type_synonym
obj = "cname × subo set"
definition init_class_fieldmap :: "prog ⇒ cname ⇒ (vname ⇀ val)" where
"init_class_fieldmap P C ≡
map_of (map (λ(F,T).(F,default_val T)) (fst(snd(the(class P C)))) )"
inductive
init_obj :: "prog ⇒ cname ⇒ (path × (vname ⇀ val)) ⇒ bool"
for P :: prog and C :: cname
where
"Subobjs P C Cs ⟹ init_obj P C (Cs,init_class_fieldmap P (last Cs))"
lemma init_obj_nonempty: "init_obj P C (Cs,fs) ⟹ Cs ≠ []"
by (fastforce elim:init_obj.cases dest:Subobjs_nonempty)
lemma init_obj_no_Ref:
"⟦init_obj P C (Cs,fs); fs F = Some(Ref(a',Cs'))⟧ ⟹ False"
by (fastforce elim:init_obj.cases default_val_no_Ref
simp:init_class_fieldmap_def map_of_map)
lemma SubobjsSet_init_objSet:
"{Cs. Subobjs P C Cs} = {Cs. ∃vmap. init_obj P C (Cs,vmap)}"
by ( fastforce intro:init_obj.intros elim:init_obj.cases)
definition obj_ty :: "obj ⇒ ty" where
"obj_ty obj ≡ Class (fst obj)"
definition blank :: "prog ⇒ cname ⇒ obj" where
"blank P C ≡ (C, Collect (init_obj P C))"
lemma [simp]: "obj_ty (C,S) = Class C"
by (simp add: obj_ty_def)
subsection‹Heap›
type_synonym heap = "addr ⇀ obj"
abbreviation
cname_of :: "heap ⇒ addr ⇒ cname" where
"cname_of hp a == fst (the (hp a))"
definition new_Addr :: "heap ⇒ addr option" where
"new_Addr h ≡ if ∃a. h a = None then Some(SOME a. h a = None) else None"
lemma new_Addr_SomeD:
"new_Addr h = Some a ⟹ h a = None"
by(fastforce simp add:new_Addr_def split:if_splits intro:someI)
end
Theory Exceptions
section ‹Exceptions›
theory Exceptions imports Objects begin
subsection ‹Exceptions›
definition NullPointer :: cname where
"NullPointer ≡ ''NullPointer''"
definition ClassCast :: cname where
"ClassCast ≡ ''ClassCast''"
definition OutOfMemory :: cname where
"OutOfMemory ≡ ''OutOfMemory''"
definition sys_xcpts :: "cname set" where
"sys_xcpts ≡ {NullPointer, ClassCast, OutOfMemory}"
definition addr_of_sys_xcpt :: "cname ⇒ addr" where
"addr_of_sys_xcpt s ≡ if s = NullPointer then 0 else
if s = ClassCast then 1 else
if s = OutOfMemory then 2 else undefined"
definition start_heap :: "prog ⇒ heap" where
"start_heap P ≡ Map.empty (addr_of_sys_xcpt NullPointer ↦ blank P NullPointer)
(addr_of_sys_xcpt ClassCast ↦ blank P ClassCast)
(addr_of_sys_xcpt OutOfMemory ↦ blank P OutOfMemory)"
definition preallocated :: "heap ⇒ bool" where
"preallocated h ≡ ∀C ∈ sys_xcpts. ∃S. h (addr_of_sys_xcpt C) = Some (C,S)"
subsection "System exceptions"
lemma [simp]:
"NullPointer ∈ sys_xcpts ∧ OutOfMemory ∈ sys_xcpts ∧ ClassCast ∈ sys_xcpts"
by(simp add: sys_xcpts_def)
lemma sys_xcpts_cases [consumes 1, cases set]:
"⟦ C ∈ sys_xcpts; P NullPointer; P OutOfMemory; P ClassCast⟧ ⟹ P C"
by (auto simp add: sys_xcpts_def)
subsection "@{term preallocated}"
lemma preallocated_dom [simp]:
"⟦ preallocated h; C ∈ sys_xcpts ⟧ ⟹ addr_of_sys_xcpt C ∈ dom h"
by (fastforce simp:preallocated_def dom_def)
lemma preallocatedD:
"⟦ preallocated h; C ∈ sys_xcpts ⟧ ⟹ ∃S. h (addr_of_sys_xcpt C) = Some (C,S)"
by(auto simp add: preallocated_def sys_xcpts_def)
lemma preallocatedE [elim?]:
"⟦ preallocated h; C ∈ sys_xcpts; ⋀S. h (addr_of_sys_xcpt C) = Some(C,S) ⟹ P h C⟧
⟹ P h C"
by (fast dest: preallocatedD)
lemma cname_of_xcp [simp]:
"⟦ preallocated h; C ∈ sys_xcpts ⟧ ⟹ cname_of h (addr_of_sys_xcpt C) = C"
by (auto elim: preallocatedE)
lemma preallocated_start:
"preallocated (start_heap P)"
by (auto simp add: start_heap_def blank_def sys_xcpts_def fun_upd_apply
addr_of_sys_xcpt_def preallocated_def)
subsection "@{term start_heap}"
lemma start_Subobj:
"⟦start_heap P a = Some(C, S); (Cs,fs) ∈ S⟧ ⟹ Subobjs P C Cs"
by (fastforce elim:init_obj.cases simp:start_heap_def blank_def
fun_upd_apply split:if_split_asm)
lemma start_SuboSet:
"⟦start_heap P a = Some(C, S); Subobjs P C Cs⟧ ⟹ ∃fs. (Cs,fs) ∈ S"
by (fastforce intro:init_obj.intros simp:start_heap_def blank_def
split:if_split_asm)
lemma start_init_obj: "start_heap P a = Some(C,S) ⟹ S = Collect (init_obj P C)"
by (auto simp:start_heap_def blank_def split:if_split_asm)
lemma start_subobj:
"⟦start_heap P a = Some(C, S); ∃fs. (Cs, fs) ∈ S⟧ ⟹ Subobjs P C Cs"
by (fastforce elim:init_obj.cases simp:start_heap_def blank_def
split:if_split_asm)
end
Theory Syntax
section ‹Syntax›
theory Syntax imports Exceptions begin
text‹Syntactic sugar›
abbreviation (input)
InitBlock :: "vname ⇒ ty ⇒ expr ⇒ expr ⇒ expr" ("(1'{_:_ := _;/ _})") where
"InitBlock V T e1 e2 == {V:T; V := e1;; e2}"
abbreviation unit where "unit == Val Unit"
abbreviation null where "null == Val Null"
abbreviation "ref r == Val(Ref r)"
abbreviation "true == Val(Bool True)"
abbreviation "false == Val(Bool False)"
abbreviation
Throw :: "reference ⇒ expr" where
"Throw r == throw(ref r)"
abbreviation (input)
THROW :: "cname ⇒ expr" where
"THROW xc == Throw(addr_of_sys_xcpt xc,[xc])"
end
Theory State
section ‹Program State›
theory State imports Exceptions begin
type_synonym
locals = "vname ⇀ val"
type_synonym
state = "heap × locals"
definition hp :: "state ⇒ heap" where
"hp ≡ fst"
definition lcl :: "state ⇒ locals" where
"lcl ≡ snd"
declare hp_def[simp] lcl_def[simp]
end
Theory BigStep
section ‹Big Step Semantics›
theory BigStep
imports Syntax State
begin
subsection ‹The rules›
inductive
eval :: "prog ⇒ env ⇒ expr ⇒ state ⇒ expr ⇒ state ⇒ bool"
("_,_ ⊢ ((1⟨_,/_⟩) ⇒/ (1⟨_,/_⟩))" [51,0,0,0,0] 81)
and evals :: "prog ⇒ env ⇒ expr list ⇒ state ⇒ expr list ⇒ state ⇒ bool"
("_,_ ⊢ ((1⟨_,/_⟩) [⇒]/ (1⟨_,/_⟩))" [51,0,0,0,0] 81)
for P :: prog
where
New:
"⟦ new_Addr h = Some a; h' = h(a↦(C,Collect (init_obj P C))) ⟧
⟹ P,E ⊢ ⟨new C,(h,l)⟩ ⇒ ⟨ref (a,[C]),(h',l)⟩"
| NewFail:
"new_Addr h = None ⟹
P,E ⊢ ⟨new C, (h,l)⟩ ⇒ ⟨THROW OutOfMemory,(h,l)⟩"
| StaticUpCast:
"⟦ P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref (a,Cs),s⇩1⟩; P ⊢ Path last Cs to C via Cs'; Ds = Cs@⇩pCs' ⟧
⟹ P,E ⊢ ⟨⦇C⦈e,s⇩0⟩ ⇒ ⟨ref (a,Ds),s⇩1⟩"
| StaticDownCast:
"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref (a,Cs@[C]@Cs'),s⇩1⟩
⟹ P,E ⊢ ⟨⦇C⦈e,s⇩0⟩ ⇒ ⟨ref (a,Cs@[C]),s⇩1⟩"
| StaticCastNull:
"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⇩1⟩ ⟹
P,E ⊢ ⟨⦇C⦈e,s⇩0⟩ ⇒ ⟨null,s⇩1⟩"
| StaticCastFail:
"⟦ P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref (a,Cs),s⇩1⟩; ¬ P ⊢ (last Cs) ≼⇧* C; C ∉ set Cs ⟧
⟹ P,E ⊢ ⟨⦇C⦈e,s⇩0⟩ ⇒ ⟨THROW ClassCast,s⇩1⟩"
| StaticCastThrow:
"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩ ⟹
P,E ⊢ ⟨⦇C⦈e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩"
| StaticUpDynCast:
"⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a,Cs),s⇩1⟩; P ⊢ Path last Cs to C unique;
P ⊢ Path last Cs to C via Cs'; Ds = Cs@⇩pCs' ⟧
⟹ P,E ⊢ ⟨Cast C e,s⇩0⟩ ⇒ ⟨ref(a,Ds),s⇩1⟩"
| StaticDownDynCast:
"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref (a,Cs@[C]@Cs'),s⇩1⟩
⟹ P,E ⊢ ⟨Cast C e,s⇩0⟩ ⇒ ⟨ref (a,Cs@[C]),s⇩1⟩"
| DynCast:
"⟦ P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref (a,Cs),(h,l)⟩; h a = Some(D,S);
P ⊢ Path D to C via Cs'; P ⊢ Path D to C unique ⟧
⟹ P,E ⊢ ⟨Cast C e,s⇩0⟩ ⇒ ⟨ref (a,Cs'),(h,l)⟩"
| DynCastNull:
"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⇩1⟩ ⟹
P,E ⊢ ⟨Cast C e,s⇩0⟩ ⇒ ⟨null,s⇩1⟩"
| DynCastFail:
"⟦ P,E ⊢ ⟨e,s⇩0⟩⇒ ⟨ref (a,Cs),(h,l)⟩; h a = Some(D,S); ¬ P ⊢ Path D to C unique;
¬ P ⊢ Path last Cs to C unique; C ∉ set Cs ⟧
⟹ P,E ⊢ ⟨Cast C e,s⇩0⟩ ⇒ ⟨null,(h,l)⟩"
| DynCastThrow:
"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩ ⟹
P,E ⊢ ⟨Cast C e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩"
| Val:
"P,E ⊢ ⟨Val v,s⟩ ⇒ ⟨Val v,s⟩"
| BinOp:
"⟦ P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨Val v⇩1,s⇩1⟩; P,E ⊢ ⟨e⇩2,s⇩1⟩ ⇒ ⟨Val v⇩2,s⇩2⟩;
binop(bop,v⇩1,v⇩2) = Some v ⟧
⟹ P,E ⊢ ⟨e⇩1 «bop» e⇩2,s⇩0⟩⇒⟨Val v,s⇩2⟩"
| BinOpThrow1:
"P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨throw e,s⇩1⟩ ⟹
P,E ⊢ ⟨e⇩1 «bop» e⇩2, s⇩0⟩ ⇒ ⟨throw e,s⇩1⟩"
| BinOpThrow2:
"⟦ P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨Val v⇩1,s⇩1⟩; P,E ⊢ ⟨e⇩2,s⇩1⟩ ⇒ ⟨throw e,s⇩2⟩ ⟧
⟹ P,E ⊢ ⟨e⇩1 «bop» e⇩2,s⇩0⟩ ⇒ ⟨throw e,s⇩2⟩"
| Var:
"l V = Some v ⟹
P,E ⊢ ⟨Var V,(h,l)⟩ ⇒ ⟨Val v,(h,l)⟩"
| LAss:
"⟦ P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨Val v,(h,l)⟩; E V = Some T;
P ⊢ T casts v to v'; l' = l(V↦v') ⟧
⟹ P,E ⊢ ⟨V:=e,s⇩0⟩ ⇒ ⟨Val v',(h,l')⟩"
| LAssThrow:
"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩ ⟹
P,E ⊢ ⟨V:=e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩"
| FAcc:
"⟦ P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref (a,Cs'),(h,l)⟩; h a = Some(D,S);
Ds = Cs'@⇩pCs; (Ds,fs) ∈ S; fs F = Some v ⟧
⟹ P,E ⊢ ⟨e∙F{Cs},s⇩0⟩ ⇒ ⟨Val v,(h,l)⟩"
| FAccNull:
"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⇩1⟩ ⟹
P,E ⊢ ⟨e∙F{Cs},s⇩0⟩ ⇒ ⟨THROW NullPointer,s⇩1⟩"
| FAccThrow:
"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩ ⟹
P,E ⊢ ⟨e∙F{Cs},s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩"
| FAss:
"⟦ P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨ref (a,Cs'),s⇩1⟩; P,E ⊢ ⟨e⇩2,s⇩1⟩ ⇒ ⟨Val v,(h⇩2,l⇩2)⟩;
h⇩2 a = Some(D,S); P ⊢ (last Cs') has least F:T via Cs; P ⊢ T casts v to v';
Ds = Cs'@⇩pCs; (Ds,fs) ∈ S; fs' = fs(F↦v');
S' = S - {(Ds,fs)} ∪ {(Ds,fs')}; h⇩2' = h⇩2(a↦(D,S'))⟧
⟹ P,E ⊢ ⟨e⇩1∙F{Cs}:=e⇩2,s⇩0⟩ ⇒ ⟨Val v',(h⇩2',l⇩2)⟩"
| FAssNull:
"⟦ P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨null,s⇩1⟩; P,E ⊢ ⟨e⇩2,s⇩1⟩ ⇒ ⟨Val v,s⇩2⟩ ⟧ ⟹
P,E ⊢ ⟨e⇩1∙F{Cs}:=e⇩2,s⇩0⟩ ⇒ ⟨THROW NullPointer,s⇩2⟩"
| FAssThrow1:
"P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩ ⟹
P,E ⊢ ⟨e⇩1∙F{Cs}:=e⇩2,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩"
| FAssThrow2:
"⟦ P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨Val v,s⇩1⟩; P,E ⊢ ⟨e⇩2,s⇩1⟩ ⇒ ⟨throw e',s⇩2⟩ ⟧
⟹ P,E ⊢ ⟨e⇩1∙F{Cs}:=e⇩2,s⇩0⟩ ⇒ ⟨throw e',s⇩2⟩"
| CallObjThrow:
"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩ ⟹
P,E ⊢ ⟨Call e Copt M es,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩"
| CallParamsThrow:
"⟦ P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨Val v,s⇩1⟩; P,E ⊢ ⟨es,s⇩1⟩ [⇒] ⟨map Val vs @ throw ex # es',s⇩2⟩ ⟧
⟹ P,E ⊢ ⟨Call e Copt M es,s⇩0⟩ ⇒ ⟨throw ex,s⇩2⟩"
| Call:
"⟦ P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref (a,Cs),s⇩1⟩; P,E ⊢ ⟨ps,s⇩1⟩ [⇒] ⟨map Val vs,(h⇩2,l⇩2)⟩;
h⇩2 a = Some(C,S); P ⊢ last Cs has least M = (Ts',T',pns',body') via Ds;
P ⊢ (C,Cs@⇩pDs) selects M = (Ts,T,pns,body) via Cs'; length vs = length pns;
P ⊢ Ts Casts vs to vs'; l⇩2' = [this↦Ref (a,Cs'), pns[↦]vs'];
new_body = (case T' of Class D ⇒ ⦇D⦈body | _ ⇒ body);
P,E(this↦Class(last Cs'), pns[↦]Ts) ⊢ ⟨new_body,(h⇩2,l⇩2')⟩ ⇒ ⟨e',(h⇩3,l⇩3)⟩ ⟧
⟹ P,E ⊢ ⟨e∙M(ps),s⇩0⟩ ⇒ ⟨e',(h⇩3,l⇩2)⟩"
| StaticCall:
"⟦ P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref (a,Cs),s⇩1⟩; P,E ⊢ ⟨ps,s⇩1⟩ [⇒] ⟨map Val vs,(h⇩2,l⇩2)⟩;
P ⊢ Path (last Cs) to C unique; P ⊢ Path (last Cs) to C via Cs'';
P ⊢ C has least M = (Ts,T,pns,body) via Cs'; Ds = (Cs@⇩pCs'')@⇩pCs';
length vs = length pns; P ⊢ Ts Casts vs to vs';
l⇩2' = [this↦Ref (a,Ds), pns[↦]vs'];
P,E(this↦Class(last Ds), pns[↦]Ts) ⊢ ⟨body,(h⇩2,l⇩2')⟩ ⇒ ⟨e',(h⇩3,l⇩3)⟩ ⟧
⟹ P,E ⊢ ⟨e∙(C::)M(ps),s⇩0⟩ ⇒ ⟨e',(h⇩3,l⇩2)⟩"
| CallNull:
"⟦ P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⇩1⟩; P,E ⊢ ⟨es,s⇩1⟩ [⇒] ⟨map Val vs,s⇩2⟩ ⟧
⟹ P,E ⊢ ⟨Call e Copt M es,s⇩0⟩ ⇒ ⟨THROW NullPointer,s⇩2⟩"
| Block:
"⟦P,E(V ↦ T) ⊢ ⟨e⇩0,(h⇩0,l⇩0(V:=None))⟩ ⇒ ⟨e⇩1,(h⇩1,l⇩1)⟩ ⟧ ⟹
P,E ⊢ ⟨{V:T; e⇩0},(h⇩0,l⇩0)⟩ ⇒ ⟨e⇩1,(h⇩1,l⇩1(V:=l⇩0 V))⟩"
| Seq:
"⟦ P,E ⊢ ⟨e⇩0,s⇩0⟩ ⇒ ⟨Val v,s⇩1⟩; P,E ⊢ ⟨e⇩1,s⇩1⟩ ⇒ ⟨e⇩2,s⇩2⟩ ⟧
⟹ P,E ⊢ ⟨e⇩0;;e⇩1,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩"
| SeqThrow:
"P,E ⊢ ⟨e⇩0,s⇩0⟩ ⇒ ⟨throw e,s⇩1⟩ ⟹
P,E ⊢ ⟨e⇩0;;e⇩1,s⇩0⟩⇒⟨throw e,s⇩1⟩"
| CondT:
"⟦ P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨true,s⇩1⟩; P,E ⊢ ⟨e⇩1,s⇩1⟩ ⇒ ⟨e',s⇩2⟩ ⟧
⟹ P,E ⊢ ⟨if (e) e⇩1 else e⇩2,s⇩0⟩ ⇒ ⟨e',s⇩2⟩"
| CondF:
"⟦ P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨false,s⇩1⟩; P,E ⊢ ⟨e⇩2,s⇩1⟩ ⇒ ⟨e',s⇩2⟩ ⟧
⟹ P,E ⊢ ⟨if (e) e⇩1 else e⇩2,s⇩0⟩ ⇒ ⟨e',s⇩2⟩"
| CondThrow:
"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩ ⟹
P,E ⊢ ⟨if (e) e⇩1 else e⇩2, s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩"
| WhileF:
"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨false,s⇩1⟩ ⟹
P,E ⊢ ⟨while (e) c,s⇩0⟩ ⇒ ⟨unit,s⇩1⟩"
| WhileT:
"⟦ P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨true,s⇩1⟩; P,E ⊢ ⟨c,s⇩1⟩ ⇒ ⟨Val v⇩1,s⇩2⟩;
P,E ⊢ ⟨while (e) c,s⇩2⟩ ⇒ ⟨e⇩3,s⇩3⟩ ⟧
⟹ P,E ⊢ ⟨while (e) c,s⇩0⟩ ⇒ ⟨e⇩3,s⇩3⟩"
| WhileCondThrow:
"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ throw e',s⇩1⟩ ⟹
P,E ⊢ ⟨while (e) c,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩"
| WhileBodyThrow:
"⟦ P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨true,s⇩1⟩; P,E ⊢ ⟨c,s⇩1⟩ ⇒ ⟨throw e',s⇩2⟩⟧
⟹ P,E ⊢ ⟨while (e) c,s⇩0⟩ ⇒ ⟨throw e',s⇩2⟩"
| Throw:
"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref r,s⇩1⟩ ⟹
P,E ⊢ ⟨throw e,s⇩0⟩ ⇒ ⟨Throw r,s⇩1⟩"
| ThrowNull:
"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⇩1⟩ ⟹
P,E ⊢ ⟨throw e,s⇩0⟩ ⇒ ⟨THROW NullPointer,s⇩1⟩"
| ThrowThrow:
"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩ ⟹
P,E ⊢ ⟨throw e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩"
| Nil:
"P,E ⊢ ⟨[],s⟩ [⇒] ⟨[],s⟩"
| Cons:
"⟦ P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨Val v,s⇩1⟩; P,E ⊢ ⟨es,s⇩1⟩ [⇒] ⟨es',s⇩2⟩ ⟧
⟹ P,E ⊢ ⟨e#es,s⇩0⟩ [⇒] ⟨Val v # es',s⇩2⟩"
| ConsThrow:
"P,E ⊢ ⟨e, s⇩0⟩ ⇒ ⟨throw e', s⇩1⟩ ⟹
P,E ⊢ ⟨e#es, s⇩0⟩ [⇒] ⟨throw e' # es, s⇩1⟩"
lemmas eval_evals_induct = eval_evals.induct [split_format (complete)]
and eval_evals_inducts = eval_evals.inducts [split_format (complete)]
inductive_cases eval_cases [cases set]:
"P,E ⊢ ⟨new C,s⟩ ⇒ ⟨e',s'⟩"
"P,E ⊢ ⟨Cast C e,s⟩ ⇒ ⟨e',s'⟩"
"P,E ⊢ ⟨⦇C⦈e,s⟩ ⇒ ⟨e',s'⟩"
"P,E ⊢ ⟨Val v,s⟩ ⇒ ⟨e',s'⟩"
"P,E ⊢ ⟨e⇩1 «bop» e⇩2,s⟩ ⇒ ⟨e',s'⟩"
"P,E ⊢ ⟨Var V,s⟩ ⇒ ⟨e',s'⟩"
"P,E ⊢ ⟨V:=e,s⟩ ⇒ ⟨e',s'⟩"
"P,E ⊢ ⟨e∙F{Cs},s⟩ ⇒ ⟨e',s'⟩"
"P,E ⊢ ⟨e⇩1∙F{Cs}:=e⇩2,s⟩ ⇒ ⟨e',s'⟩"
"P,E ⊢ ⟨e∙M(es),s⟩ ⇒ ⟨e',s'⟩"
"P,E ⊢ ⟨e∙(C::)M(es),s⟩ ⇒ ⟨e',s'⟩"
"P,E ⊢ ⟨{V:T;e⇩1},s⟩ ⇒ ⟨e',s'⟩"
"P,E ⊢ ⟨e⇩1;;e⇩2,s⟩ ⇒ ⟨e',s'⟩"
"P,E ⊢ ⟨if (e) e⇩1 else e⇩2,s⟩ ⇒ ⟨e',s'⟩"
"P,E ⊢ ⟨while (b) c,s⟩ ⇒ ⟨e',s'⟩"
"P,E ⊢ ⟨throw e,s⟩ ⇒ ⟨e',s'⟩"
inductive_cases evals_cases [cases set]:
"P,E ⊢ ⟨[],s⟩ [⇒] ⟨e',s'⟩"
"P,E ⊢ ⟨e#es,s⟩ [⇒] ⟨e',s'⟩"
subsection ‹Final expressions›
definition final :: "expr ⇒ bool" where
"final e ≡ (∃v. e = Val v) ∨ (∃r. e = Throw r)"
definition finals:: "expr list ⇒ bool" where
"finals es ≡ (∃vs. es = map Val vs) ∨ (∃vs r es'. es = map Val vs @ Throw r # es')"
lemma [simp]: "final(Val v)"
by(simp add:final_def)
lemma [simp]: "final(throw e) = (∃r. e = ref r)"
by(simp add:final_def)
lemma finalE: "⟦ final e; ⋀v. e = Val v ⟹ Q; ⋀r. e = Throw r ⟹ Q ⟧ ⟹ Q"
by(auto simp:final_def)
lemma [iff]: "finals []"
by(simp add:finals_def)
lemma [iff]: "finals (Val v # es) = finals es"
apply(clarsimp simp add:finals_def)
apply(rule iffI)
apply(erule disjE)
apply simp
apply(rule disjI2)
apply clarsimp
apply(case_tac vs)
apply simp
apply fastforce
apply(erule disjE)
apply (rule disjI1)
apply clarsimp
apply(rule disjI2)
apply clarsimp
apply(rule_tac x = "v#vs" in exI)
apply simp
done
lemma finals_app_map[iff]: "finals (map Val vs @ es) = finals es"
by(induct_tac vs, auto)
lemma [iff]: "finals (map Val vs)"
using finals_app_map[of vs "[]"]by(simp)
lemma [iff]: "finals (throw e # es) = (∃r. e = ref r)"
apply(simp add:finals_def)
apply(rule iffI)
apply clarsimp
apply(case_tac vs)
apply simp
apply fastforce
apply fastforce
done
lemma not_finals_ConsI: "¬ final e ⟹ ¬ finals(e#es)"
apply(auto simp add:finals_def final_def)
apply(case_tac vs)
apply auto
done
lemma eval_final: "P,E ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩ ⟹ final e'"
and evals_final: "P,E ⊢ ⟨es,s⟩ [⇒] ⟨es',s'⟩ ⟹ finals es'"
by(induct rule:eval_evals.inducts, simp_all)
lemma eval_lcl_incr: "P,E ⊢ ⟨e,(h⇩0,l⇩0)⟩ ⇒ ⟨e',(h⇩1,l⇩1)⟩ ⟹ dom l⇩0 ⊆ dom l⇩1"
and evals_lcl_incr: "P,E ⊢ ⟨es,(h⇩0,l⇩0)⟩ [⇒] ⟨es',(h⇩1,l⇩1)⟩ ⟹ dom l⇩0 ⊆ dom l⇩1"
by (induct rule:eval_evals_inducts) (auto simp del:fun_upd_apply)
text‹Only used later, in the small to big translation, but is already a
good sanity check:›
lemma eval_finalId: "final e ⟹ P,E ⊢ ⟨e,s⟩ ⇒ ⟨e,s⟩"
by (erule finalE) (fastforce intro: eval_evals.intros)+
lemma eval_finalsId:
assumes finals: "finals es" shows "P,E ⊢ ⟨es,s⟩ [⇒] ⟨es,s⟩"
using finals
proof (induct es type: list)
case Nil show ?case by (rule eval_evals.intros)
next
case (Cons e es)
have hyp: "finals es ⟹ P,E ⊢ ⟨es,s⟩ [⇒] ⟨es,s⟩"
and finals: "finals (e # es)" by fact+
show "P,E ⊢ ⟨e # es,s⟩ [⇒] ⟨e # es,s⟩"
proof cases
assume "final e"
thus ?thesis
proof (cases rule: finalE)
fix v assume e: "e = Val v"
have "P,E ⊢ ⟨Val v,s⟩ ⇒ ⟨Val v,s⟩" by (simp add: eval_finalId)
moreover from finals e have "P,E ⊢ ⟨es,s⟩ [⇒] ⟨es,s⟩" by(fast intro:hyp)
ultimately have "P,E ⊢ ⟨Val v#es,s⟩ [⇒] ⟨Val v#es,s⟩"
by (rule eval_evals.intros)
with e show ?thesis by simp
next
fix a assume e: "e = Throw a"
have "P,E ⊢ ⟨Throw a,s⟩ ⇒ ⟨Throw a,s⟩" by (simp add: eval_finalId)
hence "P,E ⊢ ⟨Throw a#es,s⟩ [⇒] ⟨Throw a#es,s⟩" by (rule eval_evals.intros)
with e show ?thesis by simp
qed
next
assume "¬ final e"
with not_finals_ConsI finals have False by blast
thus ?thesis ..
qed
qed
lemma
eval_preserves_obj:"P,E ⊢ ⟨e,(h,l)⟩ ⇒ ⟨e',(h',l')⟩ ⟹ (⋀S. h a = Some(D,S)
⟹ ∃S'. h' a = Some(D,S'))"
and evals_preserves_obj:"P,E ⊢ ⟨es,(h,l)⟩ [⇒] ⟨es',(h',l')⟩
⟹ (⋀S. h a = Some(D,S) ⟹ ∃S'. h' a = Some(D,S'))"
by(induct rule:eval_evals_inducts)(fastforce dest:new_Addr_SomeD)+
end
Theory SmallStep
section ‹Small Step Semantics›
theory SmallStep imports Syntax State begin
subsection ‹Some pre-definitions›
fun blocks :: "vname list × ty list × val list × expr ⇒ expr"
where
blocks_Cons:"blocks(V#Vs, T#Ts, v#vs, e) = {V:T := Val v; blocks(Vs,Ts,vs,e)}" |
blocks_Nil: "blocks([],[],[],e) = e"
lemma blocks_old_induct:
fixes P :: "vname list ⇒ ty list ⇒ val list ⇒ expr ⇒ bool"
shows
"⟦⋀aj ak al. P [] [] (aj # ak) al; ⋀ad ae a b. P [] (ad # ae) a b;
⋀V Vs a b. P (V # Vs) [] a b; ⋀V Vs T Ts aw. P (V # Vs) (T # Ts) [] aw;
⋀V Vs T Ts v vs e. P Vs Ts vs e ⟹ P (V # Vs) (T # Ts) (v # vs) e; ⋀e. P [] [] [] e⟧
⟹ P u v w x"
by (induction_schema) (pat_completeness, lexicographic_order)
lemma [simp]:
"⟦ size vs = size Vs; size Ts = size Vs ⟧ ⟹ fv(blocks(Vs,Ts,vs,e)) = fv e - set Vs"
apply(induct rule:blocks_old_induct)
apply simp_all
apply blast
done
definition assigned :: "vname ⇒ expr ⇒ bool" where
"assigned V e ≡ ∃v e'. e = (V:= Val v;; e')"
subsection ‹The rules›
inductive_set
red :: "prog ⇒ (env × (expr × state) × (expr × state)) set"
and reds :: "prog ⇒ (env × (expr list × state) × (expr list × state)) set"
and red' :: "prog ⇒ env ⇒ expr ⇒ state ⇒ expr ⇒ state ⇒ bool"
("_,_ ⊢ ((1⟨_,/_⟩) →/ (1⟨_,/_⟩))" [51,0,0,0,0] 81)
and reds' :: "prog ⇒ env ⇒ expr list ⇒ state ⇒ expr list ⇒ state ⇒ bool"
("_,_ ⊢ ((1⟨_,/_⟩) [→]/ (1⟨_,/_⟩))" [51,0,0,0,0] 81)
for P :: prog
where
"P,E ⊢ ⟨e,s⟩ → ⟨e',s'⟩ ≡ (E,(e,s), e',s') ∈ red P"
| "P,E ⊢ ⟨es,s⟩ [→] ⟨es',s'⟩ ≡ (E,(es,s), es',s') ∈ reds P"
| RedNew:
"⟦ new_Addr h = Some a; h' = h(a↦(C,Collect (init_obj P C))) ⟧
⟹ P,E ⊢ ⟨new C, (h,l)⟩ → ⟨ref (a,[C]), (h',l)⟩"
| RedNewFail:
"new_Addr h = None ⟹
P,E ⊢ ⟨new C, (h,l)⟩ → ⟨THROW OutOfMemory, (h,l)⟩"
| StaticCastRed:
"P,E ⊢ ⟨e,s⟩ → ⟨e',s'⟩ ⟹
P,E ⊢ ⟨⦇C⦈e, s⟩ → ⟨⦇C⦈e', s'⟩"
| RedStaticCastNull:
"P,E ⊢ ⟨⦇C⦈null, s⟩ → ⟨null,s⟩"
| RedStaticUpCast:
"⟦ P ⊢ Path last Cs to C via Cs'; Ds = Cs@⇩pCs' ⟧
⟹ P,E ⊢ ⟨⦇C⦈(ref (a,Cs)), s⟩ → ⟨ref (a,Ds), s⟩"
| RedStaticDownCast:
"P,E ⊢ ⟨⦇C⦈(ref (a,Cs@[C]@Cs')), s⟩ → ⟨ref (a,Cs@[C]), s⟩"
| RedStaticCastFail:
"⟦C ∉ set Cs; ¬ P ⊢ (last Cs) ≼⇧* C⟧
⟹ P,E ⊢ ⟨⦇C⦈(ref (a,Cs)), s⟩ → ⟨THROW ClassCast, s⟩"
| DynCastRed:
"P,E ⊢ ⟨e,s⟩ → ⟨e',s'⟩ ⟹
P,E ⊢ ⟨Cast C e, s⟩ → ⟨Cast C e', s'⟩"
| RedDynCastNull:
"P,E ⊢ ⟨Cast C null, s⟩ → ⟨null,s⟩"
| RedStaticUpDynCast:
"⟦ P ⊢ Path last Cs to C unique; P ⊢ Path last Cs to C via Cs'; Ds = Cs@⇩pCs' ⟧
⟹ P,E ⊢ ⟨Cast C(ref(a,Cs)),s⟩ → ⟨ref(a,Ds),s⟩"
| RedStaticDownDynCast:
"P,E ⊢ ⟨Cast C (ref (a,Cs@[C]@Cs')), s⟩ → ⟨ref (a,Cs@[C]), s⟩"
| RedDynCast:
"⟦ hp s a = Some(D,S); P ⊢ Path D to C via Cs';
P ⊢ Path D to C unique ⟧
⟹ P,E ⊢ ⟨Cast C (ref (a,Cs)), s⟩ → ⟨ref (a,Cs'), s⟩"
| RedDynCastFail:
"⟦hp s a = Some(D,S); ¬ P ⊢ Path D to C unique;
¬ P ⊢ Path last Cs to C unique; C ∉ set Cs ⟧
⟹ P,E ⊢ ⟨Cast C (ref (a,Cs)), s⟩ → ⟨null, s⟩"
| BinOpRed1:
"P,E ⊢ ⟨e,s⟩ → ⟨e',s'⟩ ⟹
P,E ⊢ ⟨e «bop» e⇩2, s⟩ → ⟨e' «bop» e⇩2, s'⟩"
| BinOpRed2:
"P,E ⊢ ⟨e,s⟩ → ⟨e',s'⟩ ⟹
P,E ⊢ ⟨(Val v⇩1) «bop» e, s⟩ → ⟨(Val v⇩1) «bop» e', s'⟩"
| RedBinOp:
"binop(bop,v⇩1,v⇩2) = Some v ⟹
P,E ⊢ ⟨(Val v⇩1) «bop» (Val v⇩2), s⟩ → ⟨Val v,s⟩"
| RedVar:
"lcl s V = Some v ⟹
P,E ⊢ ⟨Var V,s⟩ → ⟨Val v,s⟩"
| LAssRed:
"P,E ⊢ ⟨e,s⟩ → ⟨e',s'⟩ ⟹
P,E ⊢ ⟨V:=e,s⟩ → ⟨V:=e',s'⟩"
| RedLAss:
"⟦E V = Some T; P ⊢ T casts v to v'⟧ ⟹
P,E ⊢ ⟨V:=(Val v),(h,l)⟩ → ⟨Val v',(h,l(V↦v'))⟩"
| FAccRed:
"P,E ⊢ ⟨e,s⟩ → ⟨e',s'⟩ ⟹
P,E ⊢ ⟨e∙F{Cs}, s⟩ → ⟨e'∙F{Cs}, s'⟩"
| RedFAcc:
"⟦ hp s a = Some(D,S); Ds = Cs'@⇩pCs; (Ds,fs) ∈ S; fs F = Some v ⟧
⟹ P,E ⊢ ⟨(ref (a,Cs'))∙F{Cs}, s⟩ → ⟨Val v,s⟩"
| RedFAccNull:
"P,E ⊢ ⟨null∙F{Cs}, s⟩ → ⟨THROW NullPointer, s⟩"
| FAssRed1:
"P,E ⊢ ⟨e,s⟩ → ⟨e',s'⟩ ⟹
P,E ⊢ ⟨e∙F{Cs}:=e⇩2, s⟩ → ⟨e'∙F{Cs}:=e⇩2, s'⟩"
| FAssRed2:
"P,E ⊢ ⟨e,s⟩ → ⟨e',s'⟩ ⟹
P,E ⊢ ⟨Val v∙F{Cs}:=e, s⟩ → ⟨Val v∙F{Cs}:=e', s'⟩"
| RedFAss:
"⟦h a = Some(D,S); P ⊢ (last Cs') has least F:T via Cs;
P ⊢ T casts v to v'; Ds = Cs'@⇩pCs; (Ds,fs) ∈ S⟧ ⟹
P,E ⊢ ⟨(ref (a,Cs'))∙F{Cs}:=(Val v), (h,l)⟩ → ⟨Val v', (h(a ↦ (D,insert (Ds,fs(F↦v')) (S - {(Ds,fs)}))),l)⟩"
| RedFAssNull:
"P,E ⊢ ⟨null∙F{Cs}:=Val v, s⟩ → ⟨THROW NullPointer, s⟩"
| CallObj:
"P,E ⊢ ⟨e,s⟩ → ⟨e',s'⟩ ⟹
P,E ⊢ ⟨Call e Copt M es,s⟩ → ⟨Call e' Copt M es,s'⟩"
| CallParams:
"P,E ⊢ ⟨es,s⟩ [→] ⟨es',s'⟩ ⟹
P,E ⊢ ⟨Call (Val v) Copt M es,s⟩ → ⟨Call (Val v) Copt M es',s'⟩"
| RedCall:
"⟦ hp s a = Some(C,S); P ⊢ last Cs has least M = (Ts',T',pns',body') via Ds;
P ⊢ (C,Cs@⇩pDs) selects M = (Ts,T,pns,body) via Cs';
size vs = size pns; size Ts = size pns;
bs = blocks(this#pns,Class(last Cs')#Ts,Ref(a,Cs')#vs,body);
new_body = (case T' of Class D ⇒ ⦇D⦈bs | _ ⇒ bs)⟧
⟹ P,E ⊢ ⟨(ref (a,Cs))∙M(map Val vs), s⟩ → ⟨new_body, s⟩"
| RedStaticCall:
"⟦ P ⊢ Path (last Cs) to C unique; P ⊢ Path (last Cs) to C via Cs'';
P ⊢ C has least M = (Ts,T,pns,body) via Cs'; Ds = (Cs@⇩pCs'')@⇩pCs';
size vs = size pns; size Ts = size pns ⟧
⟹ P,E ⊢ ⟨(ref (a,Cs))∙(C::)M(map Val vs), s⟩ →
⟨blocks(this#pns,Class(last Ds)#Ts,Ref(a,Ds)#vs,body), s⟩"
| RedCallNull:
"P,E ⊢ ⟨Call null Copt M (map Val vs),s⟩ → ⟨THROW NullPointer,s⟩"
| BlockRedNone:
"⟦ P,E(V ↦ T) ⊢ ⟨e, (h,l(V:=None))⟩ → ⟨e', (h',l')⟩; l' V = None; ¬ assigned V e ⟧
⟹ P,E ⊢ ⟨{V:T; e}, (h,l)⟩ → ⟨{V:T; e'}, (h',l'(V := l V))⟩"
| BlockRedSome:
"⟦ P,E(V ↦ T) ⊢ ⟨e, (h,l(V:=None))⟩ → ⟨e', (h',l')⟩; l' V = Some v;
¬ assigned V e ⟧
⟹ P,E ⊢ ⟨{V:T; e}, (h,l)⟩ → ⟨{V:T := Val v; e'}, (h',l'(V := l V))⟩"
| InitBlockRed:
"⟦ P,E(V ↦ T) ⊢ ⟨e, (h,l(V↦v'))⟩ → ⟨e', (h',l')⟩; l' V = Some v'';
P ⊢ T casts v to v' ⟧
⟹ P,E ⊢ ⟨{V:T := Val v; e}, (h,l)⟩ → ⟨{V:T := Val v''; e'}, (h',l'(V := l V))⟩"
| RedBlock:
"P,E ⊢ ⟨{V:T; Val u}, s⟩ → ⟨Val u, s⟩"
| RedInitBlock:
"P ⊢ T casts v to v' ⟹ P,E ⊢ ⟨{V:T := Val v; Val u}, s⟩ → ⟨Val u, s⟩"
| SeqRed:
"P,E ⊢ ⟨e,s⟩ → ⟨e',s'⟩ ⟹
P,E ⊢ ⟨e;;e⇩2, s⟩ → ⟨e';;e⇩2, s'⟩"
| RedSeq:
"P,E ⊢ ⟨(Val v);;e⇩2, s⟩ → ⟨e⇩2, s⟩"
| CondRed:
"P,E ⊢ ⟨e,s⟩ → ⟨e',s'⟩ ⟹
P,E ⊢ ⟨if (e) e⇩1 else e⇩2, s⟩ → ⟨if (e') e⇩1 else e⇩2, s'⟩"
| RedCondT:
"P,E ⊢ ⟨if (true) e⇩1 else e⇩2, s⟩ → ⟨e⇩1, s⟩"
| RedCondF:
"P,E ⊢ ⟨if (false) e⇩1 else e⇩2, s⟩ → ⟨e⇩2, s⟩"
| RedWhile:
"P,E ⊢ ⟨while(b) c, s⟩ → ⟨if(b) (c;;while(b) c) else unit, s⟩"
| ThrowRed:
"P,E ⊢ ⟨e,s⟩ → ⟨e',s'⟩ ⟹
P,E ⊢ ⟨throw e, s⟩ → ⟨throw e', s'⟩"
| RedThrowNull:
"P,E ⊢ ⟨throw null, s⟩ → ⟨THROW NullPointer, s⟩"
| ListRed1:
"P,E ⊢ ⟨e,s⟩ → ⟨e',s'⟩ ⟹
P,E ⊢ ⟨e#es,s⟩ [→] ⟨e'#es,s'⟩"
| ListRed2:
"P,E ⊢ ⟨es,s⟩ [→] ⟨es',s'⟩ ⟹
P,E ⊢ ⟨Val v # es,s⟩ [→] ⟨Val v # es',s'⟩"
| DynCastThrow: "P,E ⊢ ⟨Cast C (Throw r), s⟩ → ⟨Throw r, s⟩"
| StaticCastThrow: "P,E ⊢ ⟨⦇C⦈(Throw r), s⟩ → ⟨Throw r, s⟩"
| BinOpThrow1: "P,E ⊢ ⟨(Throw r) «bop» e⇩2, s⟩ → ⟨Throw r, s⟩"
| BinOpThrow2: "P,E ⊢ ⟨(Val v⇩1) «bop» (Throw r), s⟩ → ⟨Throw r, s⟩"
| LAssThrow: "P,E ⊢ ⟨V:=(Throw r), s⟩ → ⟨Throw r, s⟩"
| FAccThrow: "P,E ⊢ ⟨(Throw r)∙F{Cs}, s⟩ → ⟨Throw r, s⟩"
| FAssThrow1: "P,E ⊢ ⟨(Throw r)∙F{Cs}:=e⇩2, s⟩ → ⟨Throw r,s⟩"
| FAssThrow2: "P,E ⊢ ⟨Val v∙F{Cs}:=(Throw r), s⟩ → ⟨Throw r, s⟩"
| CallThrowObj: "P,E ⊢ ⟨Call (Throw r) Copt M es, s⟩ → ⟨Throw r, s⟩"
| CallThrowParams: "⟦ es = map Val vs @ Throw r # es' ⟧
⟹ P,E ⊢ ⟨Call (Val v) Copt M es, s⟩ → ⟨Throw r, s⟩"
| BlockThrow: "P,E ⊢ ⟨{V:T; Throw r}, s⟩ → ⟨Throw r, s⟩"
| InitBlockThrow: "P ⊢ T casts v to v'
⟹ P,E ⊢ ⟨{V:T := Val v; Throw r}, s⟩ → ⟨Throw r, s⟩"
| SeqThrow: "P,E ⊢ ⟨(Throw r);;e⇩2, s⟩ → ⟨Throw r, s⟩"
| CondThrow: "P,E ⊢ ⟨if (Throw r) e⇩1 else e⇩2, s⟩ → ⟨Throw r, s⟩"
| ThrowThrow: "P,E ⊢ ⟨throw(Throw r), s⟩ → ⟨Throw r, s⟩"
lemmas red_reds_induct = red_reds.induct [split_format (complete)]
and red_reds_inducts = red_reds.inducts [split_format (complete)]
inductive_cases [elim!]:
"P,E ⊢ ⟨V:=e,s⟩ → ⟨e',s'⟩"
"P,E ⊢ ⟨e1;;e2,s⟩ → ⟨e',s'⟩"
declare Cons_eq_map_conv [iff]
lemma "P,E ⊢ ⟨e,s⟩ → ⟨e',s'⟩ ⟹ True"
and reds_length:"P,E ⊢ ⟨es,s⟩ [→] ⟨es',s'⟩ ⟹ length es = length es'"
by (induct rule: red_reds.inducts) auto
subsection‹The reflexive transitive closure›
definition Red :: "prog ⇒ env ⇒ ((expr × state) × (expr × state)) set"
where "Red P E = {((e,s),e',s'). P,E ⊢ ⟨e,s⟩ → ⟨e',s'⟩}"
definition Reds :: "prog ⇒ env ⇒ ((expr list × state) × (expr list × state)) set"
where "Reds P E = {((es,s),es',s'). P,E ⊢ ⟨es,s⟩ [→] ⟨es',s'⟩}"
lemma[simp]: "((e,s),e',s') ∈ Red P E = P,E ⊢ ⟨e,s⟩ → ⟨e',s'⟩"
by (simp add:Red_def)
lemma[simp]: "((es,s),es',s') ∈ Reds P E = P,E ⊢ ⟨es,s⟩ [→] ⟨es',s'⟩"
by (simp add:Reds_def)
abbreviation
Step :: "prog ⇒ env ⇒ expr ⇒ state ⇒ expr ⇒ state ⇒ bool"
("_,_ ⊢ ((1⟨_,/_⟩) →*/ (1⟨_,/_⟩))" [51,0,0,0,0] 81) where
"P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ≡ ((e,s), e',s') ∈ (Red P E)⇧*"
abbreviation
Steps :: "prog ⇒ env ⇒ expr list ⇒ state ⇒ expr list ⇒ state ⇒ bool"
("_,_ ⊢ ((1⟨_,/_⟩) [→]*/ (1⟨_,/_⟩))" [51,0,0,0,0] 81) where
"P,E ⊢ ⟨es,s⟩ [→]* ⟨es',s'⟩ ≡ ((es,s), es',s') ∈ (Reds P E)⇧*"
lemma converse_rtrancl_induct_red[consumes 1]:
assumes "P,E ⊢ ⟨e,(h,l)⟩ →* ⟨e',(h',l')⟩"
and "⋀e h l. R e h l e h l"
and "⋀e⇩0 h⇩0 l⇩0 e⇩1 h⇩1 l⇩1 e' h' l'.
⟦ P,E ⊢ ⟨e⇩0,(h⇩0,l⇩0)⟩ → ⟨e⇩1,(h⇩1,l⇩1)⟩; R e⇩1 h⇩1 l⇩1 e' h' l' ⟧ ⟹ R e⇩0 h⇩0 l⇩0 e' h' l'"
shows "R e h l e' h' l'"
proof -
{ fix s s'
assume reds: "P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩"
and base: "⋀e s. R e (hp s) (lcl s) e (hp s) (lcl s)"
and IH: "⋀e⇩0 s⇩0 e⇩1 s⇩1 e' s'.
⟦ P,E ⊢ ⟨e⇩0,s⇩0⟩ → ⟨e⇩1,s⇩1⟩; R e⇩1 (hp s⇩1) (lcl s⇩1) e' (hp s') (lcl s') ⟧
⟹ R e⇩0 (hp s⇩0) (lcl s⇩0) e' (hp s') (lcl s')"
from reds have "R e (hp s) (lcl s) e' (hp s') (lcl s')"
proof (induct rule:converse_rtrancl_induct2)
case refl show ?case by(rule base)
next
case (step e⇩0 s⇩0 e s)
have Red:"((e⇩0,s⇩0),e,s) ∈ Red P E"
and R:"R e (hp s) (lcl s) e' (hp s') (lcl s')" by fact+
from IH[OF Red[simplified] R] show ?case .
qed
}
with assms show ?thesis by fastforce
qed
lemma steps_length:"P,E ⊢ ⟨es,s⟩ [→]* ⟨es',s'⟩ ⟹ length es = length es'"
by(induct rule:rtrancl_induct2,auto intro:reds_length)
subsection‹Some easy lemmas›
lemma [iff]: "¬ P,E ⊢ ⟨[],s⟩ [→] ⟨es',s'⟩"
by(blast elim: reds.cases)
lemma [iff]: "¬ P,E ⊢ ⟨Val v,s⟩ → ⟨e',s'⟩"
by(fastforce elim: red.cases)
lemma [iff]: "¬ P,E ⊢ ⟨Throw r,s⟩ → ⟨e',s'⟩"
by(fastforce elim: red.cases)
lemma red_lcl_incr: "P,E ⊢ ⟨e,(h⇩0,l⇩0)⟩ → ⟨e',(h⇩1,l⇩1)⟩ ⟹ dom l⇩0 ⊆ dom l⇩1"
and "P,E ⊢ ⟨es,(h⇩0,l⇩0)⟩ [→] ⟨es',(h⇩1,l⇩1)⟩ ⟹ dom l⇩0 ⊆ dom l⇩1"
by (induct rule: red_reds_inducts) (auto simp del:fun_upd_apply)
lemma red_lcl_add: "P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',(h',l')⟩ ⟹ (⋀l⇩0. P,E ⊢ ⟨e,(h,l⇩0++l)⟩ → ⟨e',(h',l⇩0++l')⟩)"
and "P,E ⊢ ⟨es,(h,l)⟩ [→] ⟨es',(h',l')⟩ ⟹ (⋀l⇩0. P,E ⊢ ⟨es,(h,l⇩0++l)⟩ [→] ⟨es',(h',l⇩0++l')⟩)"
proof (induct rule:red_reds_inducts)
case RedLAss thus ?case by(auto intro:red_reds.intros simp del:fun_upd_apply)
next
case RedStaticDownCast thus ?case by(fastforce intro:red_reds.intros)
next
case RedStaticUpDynCast thus ?case by(fastforce intro:red_reds.intros)
next
case RedStaticDownDynCast thus ?case by(fastforce intro:red_reds.intros)
next
case RedDynCast thus ?case by(fastforce intro:red_reds.intros)
next
case RedDynCastFail thus ?case by(fastforce intro:red_reds.intros)
next
case RedFAcc thus ?case by(fastforce intro:red_reds.intros)
next
case RedFAss thus ?case by (fastforce intro:red_reds.intros)
next
case RedCall thus ?case by (fastforce intro!:red_reds.RedCall)
next
case RedStaticCall thus ?case by(fastforce intro:red_reds.intros)
next
case (InitBlockRed E V T e h l v' e' h' l' v'' v l⇩0)
have IH: "⋀l⇩0. P,E(V ↦ T) ⊢ ⟨e,(h, l⇩0 ++ l(V ↦ v'))⟩ → ⟨e',(h', l⇩0 ++ l')⟩"
and l'V: "l' V = Some v''" and casts:"P ⊢ T casts v to v'" by fact+
from IH have IH': "P,E(V ↦ T) ⊢ ⟨e,(h, (l⇩0 ++ l)(V ↦ v'))⟩ → ⟨e',(h',l⇩0 ++ l')⟩"
by simp
have "(l⇩0 ++ l')(V := (l⇩0 ++ l) V) = l⇩0 ++ l'(V := l V)"
by(rule ext)(simp add:map_add_def)
with red_reds.InitBlockRed[OF IH' _ casts] l'V show ?case
by(simp del:fun_upd_apply)
next
case (BlockRedNone E V T e h l e' h' l' l⇩0)
have IH: "⋀l⇩0. P,E(V ↦ T) ⊢ ⟨e,(h, l⇩0 ++ l(V := None))⟩ → ⟨e',(h', l⇩0 ++ l')⟩"
and l'V: "l' V = None" and unass: "¬ assigned V e" by fact+
have "l⇩0(V := None) ++ l(V := None) = (l⇩0 ++ l)(V := None)"
by(simp add:fun_eq_iff map_add_def)
hence IH': "P,E(V ↦ T) ⊢ ⟨e,(h, (l⇩0++l)(V := None))⟩ → ⟨e',(h', l⇩0(V := None) ++ l')⟩"
using IH[of "l⇩0(V := None)"] by simp
have "(l⇩0(V := None) ++ l')(V := (l⇩0 ++ l) V) = l⇩0 ++ l'(V := l V)"
by(simp add:fun_eq_iff map_add_def)
with red_reds.BlockRedNone[OF IH' _ unass] l'V show ?case
by(simp add: map_add_def)
next
case (BlockRedSome E V T e h l e' h' l' v l⇩0)
have IH: "⋀l⇩0. P,E(V ↦ T) ⊢ ⟨e,(h, l⇩0 ++ l(V := None))⟩ → ⟨e',(h', l⇩0 ++ l')⟩"
and l'V: "l' V = Some v" and unass: "¬ assigned V e" by fact+
have "l⇩0(V := None) ++ l(V := None) = (l⇩0 ++ l)(V := None)"
by(simp add:fun_eq_iff map_add_def)
hence IH': "P,E(V ↦ T) ⊢ ⟨e,(h, (l⇩0++l)(V := None))⟩ → ⟨e',(h', l⇩0(V := None) ++ l')⟩"
using IH[of "l⇩0(V := None)"] by simp
have "(l⇩0(V := None) ++ l')(V := (l⇩0 ++ l) V) = l⇩0 ++ l'(V := l V)"
by(simp add:fun_eq_iff map_add_def)
with red_reds.BlockRedSome[OF IH' _ unass] l'V show ?case
by(simp add:map_add_def)
next
qed (simp_all add:red_reds.intros)
lemma Red_lcl_add:
assumes "P,E ⊢ ⟨e,(h,l)⟩ →* ⟨e',(h',l')⟩" shows "P,E ⊢ ⟨e,(h,l⇩0++l)⟩ →* ⟨e',(h',l⇩0++l')⟩"
using assms
proof(induct rule:converse_rtrancl_induct_red)
case 1 thus ?case by simp
next
case 2 thus ?case
by(auto dest: red_lcl_add intro: converse_rtrancl_into_rtrancl simp:Red_def)
qed
lemma
red_preserves_obj:"⟦P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',(h',l')⟩; h a = Some(D,S)⟧
⟹ ∃S'. h' a = Some(D,S')"
and reds_preserves_obj:"⟦P,E ⊢ ⟨es,(h,l)⟩ [→] ⟨es',(h',l')⟩; h a = Some(D,S)⟧
⟹ ∃S'. h' a = Some(D,S')"
by (induct rule:red_reds_inducts) (auto dest:new_Addr_SomeD)
end
Theory SystemClasses
section ‹System Classes›
theory SystemClasses imports Exceptions begin
text ‹
This theory provides definitions for the system exceptions.
›
definition NullPointerC :: "cdecl" where
"NullPointerC ≡ (NullPointer, ([],[],[]))"
definition ClassCastC :: "cdecl" where
"ClassCastC ≡ (ClassCast, ([],[],[]))"
definition OutOfMemoryC :: "cdecl" where
"OutOfMemoryC ≡ (OutOfMemory, ([],[],[]))"
definition SystemClasses :: "cdecl list" where
"SystemClasses ≡ [NullPointerC, ClassCastC, OutOfMemoryC]"
end
Theory TypeRel
section ‹The subtype relation›
theory TypeRel imports SubObj begin
inductive
widen :: "prog ⇒ ty ⇒ ty ⇒ bool" ("_ ⊢ _ ≤ _" [71,71,71] 70)
for P :: prog
where
widen_refl[iff]: "P ⊢ T ≤ T"
| widen_subcls: "P ⊢ Path C to D unique ⟹ P ⊢ Class C ≤ Class D"
| widen_null[iff]: "P ⊢ NT ≤ Class C"
abbreviation
widens :: "prog ⇒ ty list ⇒ ty list ⇒ bool"
("_ ⊢ _ [≤] _" [71,71,71] 70) where
"widens P Ts Ts' ≡ list_all2 (widen P) Ts Ts'"
inductive_simps [iff]:
"P ⊢ T ≤ Void"
"P ⊢ T ≤ Boolean"
"P ⊢ T ≤ Integer"
"P ⊢ Void ≤ T"
"P ⊢ Boolean ≤ T"
"P ⊢ Integer ≤ T"
"P ⊢ T ≤ NT"
lemmas widens_refl [iff] = list_all2_refl [of "widen P", OF widen_refl] for P
lemmas widens_Cons [iff] = list_all2_Cons1 [of "widen P"] for P
end
Theory WellType
section ‹Well-typedness of CoreC++ expressions›
theory WellType imports Syntax TypeRel begin
subsection ‹The rules›
inductive
WT :: "[prog,env,expr ,ty ] ⇒ bool"
("_,_ ⊢ _ :: _" [51,51,51]50)
and WTs :: "[prog,env,expr list,ty list] ⇒ bool"
("_,_ ⊢ _ [::] _" [51,51,51]50)
for P :: prog
where
WTNew:
"is_class P C ⟹
P,E ⊢ new C :: Class C"
| WTDynCast:
"⟦P,E ⊢ e :: Class D; is_class P C;
P ⊢ Path D to C unique ∨ (∀Cs. ¬ P ⊢ Path D to C via Cs)⟧
⟹ P,E ⊢ Cast C e :: Class C"
| WTStaticCast:
"⟦P,E ⊢ e :: Class D; is_class P C;
P ⊢ Path D to C unique ∨
(P ⊢ C ≼⇧* D ∧ (∀Cs. P ⊢ Path C to D via Cs ⟶ Subobjs⇩R P C Cs)) ⟧
⟹ P,E ⊢ ⦇C⦈e :: Class C"
| WTVal:
"typeof v = Some T ⟹
P,E ⊢ Val v :: T"
| WTVar:
"E V = Some T ⟹
P,E ⊢ Var V :: T"
| WTBinOp:
"⟦ P,E ⊢ e⇩1 :: T⇩1; P,E ⊢ e⇩2 :: T⇩2;
case bop of Eq ⇒ T⇩1 = T⇩2 ∧ T = Boolean
| Add ⇒ T⇩1 = Integer ∧ T⇩2 = Integer ∧ T = Integer ⟧
⟹ P,E ⊢ e⇩1 «bop» e⇩2 :: T"
| WTLAss:
"⟦ E V = Some T; P,E ⊢ e :: T'; P ⊢ T' ≤ T⟧
⟹ P,E ⊢ V:=e :: T"
| WTFAcc:
"⟦ P,E ⊢ e :: Class C; P ⊢ C has least F:T via Cs⟧
⟹ P,E ⊢ e∙F{Cs} :: T"
| WTFAss:
"⟦ P,E ⊢ e⇩1 :: Class C; P ⊢ C has least F:T via Cs;
P,E ⊢ e⇩2 :: T'; P ⊢ T' ≤ T⟧
⟹ P,E ⊢ e⇩1∙F{Cs}:=e⇩2 :: T"
| WTStaticCall:
"⟦ P,E ⊢ e :: Class C'; P ⊢ Path C' to C unique;
P ⊢ C has least M = (Ts,T,m) via Cs; P,E ⊢ es [::] Ts'; P ⊢ Ts' [≤] Ts ⟧
⟹ P,E ⊢ e∙(C::)M(es) :: T"
| WTCall:
"⟦ P,E ⊢ e :: Class C; P ⊢ C has least M = (Ts,T,m) via Cs;
P,E ⊢ es [::] Ts'; P ⊢ Ts' [≤] Ts ⟧
⟹ P,E ⊢ e∙M(es) :: T"
| WTBlock:
"⟦ is_type P T; P,E(V ↦ T) ⊢ e :: T' ⟧
⟹ P,E ⊢ {V:T; e} :: T'"
| WTSeq:
"⟦ P,E ⊢ e⇩1::T⇩1; P,E ⊢ e⇩2::T⇩2 ⟧
⟹ P,E ⊢ e⇩1;;e⇩2 :: T⇩2"
| WTCond:
"⟦ P,E ⊢ e :: Boolean; P,E ⊢ e⇩1::T; P,E ⊢ e⇩2::T ⟧
⟹ P,E ⊢ if (e) e⇩1 else e⇩2 :: T"
| WTWhile:
"⟦ P,E ⊢ e :: Boolean; P,E ⊢ c::T ⟧
⟹ P,E ⊢ while (e) c :: Void"
| WTThrow:
"P,E ⊢ e :: Class C ⟹
P,E ⊢ throw e :: Void"
| WTNil:
"P,E ⊢ [] [::] []"
| WTCons:
"⟦ P,E ⊢ e :: T; P,E ⊢ es [::] Ts ⟧
⟹ P,E ⊢ e#es [::] T#Ts"
declare WT_WTs.intros[intro!] WTNil[iff]
lemmas WT_WTs_induct = WT_WTs.induct [split_format (complete)]
and WT_WTs_inducts = WT_WTs.inducts [split_format (complete)]
subsection‹Easy consequences›
lemma [iff]: "(P,E ⊢ [] [::] Ts) = (Ts = [])"
apply(rule iffI)
apply (auto elim: WTs.cases)
done
lemma [iff]: "(P,E ⊢ e#es [::] T#Ts) = (P,E ⊢ e :: T ∧ P,E ⊢ es [::] Ts)"
apply(rule iffI)
apply (auto elim: WTs.cases)
done
lemma [iff]: "(P,E ⊢ (e#es) [::] Ts) =
(∃U Us. Ts = U#Us ∧ P,E ⊢ e :: U ∧ P,E ⊢ es [::] Us)"
apply(rule iffI)
apply (auto elim: WTs.cases)
done
lemma [iff]: "⋀Ts. (P,E ⊢ es⇩1 @ es⇩2 [::] Ts) =
(∃Ts⇩1 Ts⇩2. Ts = Ts⇩1 @ Ts⇩2 ∧ P,E ⊢ es⇩1 [::] Ts⇩1 ∧ P,E ⊢ es⇩2[::]Ts⇩2)"
apply(induct es⇩1 type:list)
apply simp
apply clarsimp
apply(erule thin_rl)
apply (rule iffI)
apply clarsimp
apply(rule exI)+
apply(rule conjI)
prefer 2 apply blast
apply simp
apply fastforce
done
lemma [iff]: "P,E ⊢ Val v :: T = (typeof v = Some T)"
apply(rule iffI)
apply (auto elim: WT.cases)
done
lemma [iff]: "P,E ⊢ Var V :: T = (E V = Some T)"
apply(rule iffI)
apply (auto elim: WT.cases)
done
lemma [iff]: "P,E ⊢ e⇩1;;e⇩2 :: T⇩2 = (∃T⇩1. P,E ⊢ e⇩1::T⇩1 ∧ P,E ⊢ e⇩2::T⇩2)"
apply(rule iffI)
apply (auto elim: WT.cases)
done
lemma [iff]: "(P,E ⊢ {V:T; e} :: T') = (is_type P T ∧ P,E(V↦T) ⊢ e :: T')"
apply(rule iffI)
apply (auto elim: WT.cases)
done
inductive_cases WT_elim_cases[elim!]:
"P,E ⊢ new C :: T"
"P,E ⊢ Cast C e :: T"
"P,E ⊢ ⦇C⦈e :: T"
"P,E ⊢ e⇩1 «bop» e⇩2 :: T"
"P,E ⊢ V:= e :: T"
"P,E ⊢ e∙F{Cs} :: T"
"P,E ⊢ e∙F{Cs} := v :: T"
"P,E ⊢ e∙M(ps) :: T"
"P,E ⊢ e∙(C::)M(ps) :: T"
"P,E ⊢ if (e) e⇩1 else e⇩2 :: T"
"P,E ⊢ while (e) c :: T"
"P,E ⊢ throw e :: T"
lemma wt_env_mono:
"P,E ⊢ e :: T ⟹ (⋀E'. E ⊆⇩m E' ⟹ P,E' ⊢ e :: T)" and
"P,E ⊢ es [::] Ts ⟹ (⋀E'. E ⊆⇩m E' ⟹ P,E' ⊢ es [::] Ts)"
apply(induct rule: WT_WTs_inducts)
apply(simp add: WTNew)
apply(fastforce simp: WTDynCast)
apply(fastforce simp: WTStaticCast)
apply(fastforce simp: WTVal)
apply(simp add: WTVar map_le_def dom_def)
apply(fastforce simp: WTBinOp)
apply(force simp:map_le_def)
apply(fastforce simp: WTFAcc)
apply(fastforce simp: WTFAss)
apply(fastforce simp: WTCall)
apply(fastforce simp: WTStaticCall)
apply(fastforce simp: map_le_def WTBlock)
apply(fastforce simp: WTSeq)
apply(fastforce simp: WTCond)
apply(fastforce simp: WTWhile)
apply(fastforce simp: WTThrow)
apply(simp add: WTNil)
apply(simp add: WTCons)
done
lemma WT_fv: "P,E ⊢ e :: T ⟹ fv e ⊆ dom E"
and "P,E ⊢ es [::] Ts ⟹ fvs es ⊆ dom E"
apply(induct rule:WT_WTs.inducts)
apply(simp_all del: fun_upd_apply)
apply fast+
done
end
Theory WellForm
section ‹Generic Well-formedness of programs›
theory WellForm
imports SystemClasses TypeRel WellType
begin
text ‹\noindent This theory defines global well-formedness conditions
for programs but does not look inside method bodies. Well-typing of
expressions is defined elsewhere (in theory ‹WellType›).
CoreC++ allows covariant return types›
type_synonym wf_mdecl_test = "prog ⇒ cname ⇒ mdecl ⇒ bool"
definition wf_fdecl :: "prog ⇒ fdecl ⇒ bool" where
"wf_fdecl P ≡ λ(F,T). is_type P T"
definition wf_mdecl :: "wf_mdecl_test ⇒ wf_mdecl_test" where
"wf_mdecl wf_md P C ≡ λ(M,Ts,T,mb).
(∀T∈set Ts. is_type P T) ∧ is_type P T ∧ T ≠ NT ∧ wf_md P C (M,Ts,T,mb)"
definition wf_cdecl :: "wf_mdecl_test ⇒ prog ⇒ cdecl ⇒ bool" where
"wf_cdecl wf_md P ≡ λ(C,(Bs,fs,ms)).
(∀M mthd Cs. P ⊢ C has M = mthd via Cs ⟶
(∃mthd' Cs'. P ⊢ (C,Cs) has overrider M = mthd' via Cs')) ∧
(∀f∈set fs. wf_fdecl P f) ∧ distinct_fst fs ∧
(∀m∈set ms. wf_mdecl wf_md P C m) ∧ distinct_fst ms ∧
(∀D ∈ baseClasses Bs.
is_class P D ∧ ¬ P ⊢ D ≼⇧* C ∧
(∀(M,Ts,T,m)∈set ms.
∀Ts' T' m' Cs. P ⊢ D has M = (Ts',T',m') via Cs ⟶
Ts' = Ts ∧ P ⊢ T ≤ T'))"
definition wf_syscls :: "prog ⇒ bool" where
"wf_syscls P ≡ sys_xcpts ⊆ set(map fst P)"
definition wf_prog :: "wf_mdecl_test ⇒ prog ⇒ bool" where
"wf_prog wf_md P ≡ wf_syscls P ∧ distinct_fst P ∧
(∀c ∈ set P. wf_cdecl wf_md P c)"
subsection‹Well-formedness lemmas›
lemma class_wf:
"⟦class P C = Some c; wf_prog wf_md P⟧ ⟹ wf_cdecl wf_md P (C,c)"
apply (unfold wf_prog_def class_def)
apply (fast dest: map_of_SomeD)
done
lemma is_class_xcpt:
"⟦ C ∈ sys_xcpts; wf_prog wf_md P ⟧ ⟹ is_class P C"
apply (simp add: wf_prog_def wf_syscls_def is_class_def class_def)
apply (fastforce intro!: map_of_SomeI)
done
lemma is_type_pTs:
assumes "wf_prog wf_md P" and "(C,S,fs,ms) ∈ set P" and "(M,Ts,T,m) ∈ set ms"
shows "set Ts ⊆ types P"
proof
from assms have "wf_mdecl wf_md P C (M,Ts,T,m)"
by (unfold wf_prog_def wf_cdecl_def) auto
hence "∀t ∈ set Ts. is_type P t" by (unfold wf_mdecl_def) auto
moreover fix t assume "t ∈ set Ts"
ultimately have "is_type P t" by blast
thus "t ∈ types P" ..
qed
subsection‹Well-formedness subclass lemmas›
lemma subcls1_wfD:
"⟦ P ⊢ C ≺⇧1 D; wf_prog wf_md P ⟧ ⟹ D ≠ C ∧ (D,C) ∉ (subcls1 P)⇧+"
apply( frule r_into_trancl)
apply( drule subcls1D)
apply(clarify)
apply( drule (1) class_wf)
apply( unfold wf_cdecl_def baseClasses_def)
apply(force simp add: reflcl_trancl [THEN sym] simp del: reflcl_trancl)
done
lemma wf_cdecl_supD:
"⟦wf_cdecl wf_md P (C,Bs,r); D ∈ baseClasses Bs⟧ ⟹ is_class P D"
by (auto simp: wf_cdecl_def baseClasses_def)
lemma subcls_asym:
"⟦ wf_prog wf_md P; (C,D) ∈ (subcls1 P)⇧+ ⟧ ⟹ (D,C) ∉ (subcls1 P)⇧+"
apply(erule trancl.cases)
apply(fast dest!: subcls1_wfD )
apply(fast dest!: subcls1_wfD intro: trancl_trans)
done
lemma subcls_irrefl:
"⟦ wf_prog wf_md P; (C,D) ∈ (subcls1 P)⇧+ ⟧ ⟹ C ≠ D"
apply (erule trancl_trans_induct)
apply (auto dest: subcls1_wfD subcls_asym)
done
lemma subcls_asym2:
"⟦ (C,D) ∈ (subcls1 P)⇧*; wf_prog wf_md P; (D,C) ∈ (subcls1 P)⇧* ⟧ ⟹ C = D"
apply (induct rule:rtrancl.induct)
apply simp
apply (drule rtrancl_into_trancl1)
apply simp
apply (drule subcls_asym)
apply simp
apply(drule rtranclD)
apply simp
done
lemma acyclic_subcls1:
"wf_prog wf_md P ⟹ acyclic (subcls1 P)"
apply (unfold acyclic_def)
apply (fast dest: subcls_irrefl)
done
lemma wf_subcls1:
"wf_prog wf_md P ⟹ wf ((subcls1 P)¯)"
apply (rule finite_acyclic_wf_converse)
apply (rule finite_subcls1)
apply (erule acyclic_subcls1)
done
lemma subcls_induct:
"⟦ wf_prog wf_md P; ⋀C. ∀D. (C,D) ∈ (subcls1 P)⇧+ ⟶ Q D ⟹ Q C ⟧ ⟹ Q C"
(is "?A ⟹ PROP ?P ⟹ _")
proof -
assume p: "PROP ?P"
assume ?A thus ?thesis apply -
apply(drule wf_subcls1)
apply(drule wf_trancl)
apply(simp only: trancl_converse)
apply(erule_tac a = C in wf_induct)
apply(rule p)
apply(auto)
done
qed
subsection‹Well-formedness leq\_path lemmas›
lemma last_leq_path:
assumes leq:"P,C ⊢ Cs ⊏⇧1 Ds" and wf:"wf_prog wf_md P"
shows "P ⊢ last Cs ≺⇧1 last Ds"
using leq
proof (induct rule:leq_path1.induct)
fix Cs Ds assume suboCs:"Subobjs P C Cs" and suboDs:"Subobjs P C Ds"
and butlast:"Cs = butlast Ds"
from suboDs have notempty:"Ds ≠ []" by -(drule Subobjs_nonempty)
with butlast have DsCs:"Ds = Cs @ [last Ds]" by simp
from suboCs have notempty:"Cs ≠ []" by -(drule Subobjs_nonempty)
with DsCs have "Ds = ((butlast Cs) @ [last Cs]) @ [last Ds]" by simp
with suboDs have "Subobjs P C ((butlast Cs) @ [last Cs,last Ds])"
by simp
thus "P ⊢ last Cs ≺⇧1 last Ds" by (fastforce intro:subclsR_subcls1 Subobjs_subclsR)
next
fix Cs D assume "P ⊢ last Cs ≺⇩S D"
thus "P ⊢ last Cs ≺⇧1 last [D]" by (fastforce intro:subclsS_subcls1)
qed
lemma last_leq_paths:
assumes leq:"(Cs,Ds) ∈ (leq_path1 P C)⇧+" and wf:"wf_prog wf_md P"
shows "(last Cs,last Ds) ∈ (subcls1 P)⇧+"
using leq
proof (induct rule:trancl.induct)
fix Cs Ds assume "P,C ⊢ Cs ⊏⇧1 Ds"
thus "(last Cs, last Ds) ∈ (subcls1 P)⇧+" using wf
by (fastforce intro:r_into_trancl elim:last_leq_path)
next
fix Cs Cs' Ds assume "(last Cs, last Cs') ∈ (subcls1 P)⇧+"
and "P,C ⊢ Cs' ⊏⇧1 Ds"
thus "(last Cs, last Ds) ∈ (subcls1 P)⇧+" using wf
by (fastforce dest:last_leq_path)
qed
lemma leq_path1_wfD:
"⟦ P,C ⊢ Cs ⊏⇧1 Cs'; wf_prog wf_md P ⟧ ⟹ Cs ≠ Cs' ∧ (Cs',Cs) ∉ (leq_path1 P C)⇧+"
apply (rule conjI)
apply (erule leq_path1.cases)
apply simp
apply (drule_tac Cs="Ds" in Subobjs_nonempty)
apply (rule butlast_noteq) apply assumption
apply clarsimp
apply (drule subclsS_subcls1)
apply (drule subcls1_wfD) apply simp_all
apply clarsimp
apply (frule last_leq_path)
apply simp
apply (drule last_leq_paths)
apply simp
apply (drule_tac r="subcls1 P" in r_into_trancl)
apply (drule subcls_asym)
apply auto
done
lemma leq_path_asym:
"⟦(Cs,Cs') ∈ (leq_path1 P C)⇧+; wf_prog wf_md P⟧ ⟹ (Cs',Cs) ∉ (leq_path1 P C)⇧+"
apply(erule tranclE)
apply(fast dest!:leq_path1_wfD )
apply(fast dest!:leq_path1_wfD intro: trancl_trans)
done
lemma leq_path_asym2:"⟦P,C ⊢ Cs ⊑ Cs'; P,C ⊢ Cs' ⊑ Cs; wf_prog wf_md P⟧ ⟹ Cs = Cs'"
apply (induct rule:rtrancl.induct)
apply simp
apply (drule rtrancl_into_trancl1)
apply simp
apply (drule leq_path_asym)
apply simp
apply (drule_tac a="c" and b="a" in rtranclD)
apply simp
done
lemma leq_path_Subobjs:
"⟦P,C ⊢ [C] ⊑ Cs; is_class P C; wf_prog wf_md P⟧ ⟹ Subobjs P C Cs"
by (induct rule:rtrancl_induct,auto intro:Subobjs_Base elim!:leq_path1.cases,
auto dest!:Subobjs_subclass intro!:Subobjs_Sh SubobjsR_Base dest!:subclsSD
intro:wf_cdecl_supD class_wf ShBaseclass_isBaseclass subclsSI)
subsection‹Lemmas concerning Subobjs›
lemma Subobj_last_isClass:"⟦wf_prog wf_md P; Subobjs P C Cs⟧ ⟹ is_class P (last Cs)"
apply (frule Subobjs_isClass)
apply (drule Subobjs_subclass)
apply (drule rtranclD)
apply (erule disjE)
apply simp
apply clarsimp
apply (erule trancl_induct)
apply (fastforce dest:subcls1D class_wf elim:wf_cdecl_supD)
apply (fastforce dest:subcls1D class_wf elim:wf_cdecl_supD)
done
lemma converse_SubobjsR_Rep:
"⟦Subobjs⇩R P C Cs; P ⊢ last Cs ≺⇩R C'; wf_prog wf_md P⟧
⟹ Subobjs⇩R P C (Cs@[C'])"
apply (induct rule:Subobjs⇩R.induct)
apply (frule subclsR_subcls1)
apply (fastforce dest!:subcls1D class_wf wf_cdecl_supD SubobjsR_Base SubobjsR_Rep)
apply (fastforce elim:SubobjsR_Rep simp: SubobjsR_nonempty split:if_split_asm)
done
lemma converse_Subobjs_Rep:
"⟦Subobjs P C Cs; P ⊢ last Cs ≺⇩R C'; wf_prog wf_md P⟧
⟹ Subobjs P C (Cs@[C'])"
by (induct rule:Subobjs.induct, fastforce dest:converse_SubobjsR_Rep Subobjs_Rep,
fastforce dest:converse_SubobjsR_Rep Subobjs_Sh)
lemma isSubobj_Subobjs_rev:
assumes subo:"is_subobj P ((C,C'#rev Cs'))" and wf:"wf_prog wf_md P"
shows "Subobjs P C (C'#rev Cs')"
using subo
proof (induct Cs')
case Nil
show ?case
proof (cases "C=C'")
case True
have "is_subobj P ((C,C'#rev []))" by fact
with True have "is_subobj P ((C,[C]))" by simp
hence "is_class P C"
by (fastforce elim:converse_rtranclE dest:subclsS_subcls1 elim:subcls1_class)
with True show ?thesis by (fastforce intro:Subobjs_Base)
next
case False
have "is_subobj P ((C,C'#rev []))" by fact
with False obtain D where sup:"P ⊢ C ≼⇧* D" and subS:"P ⊢ D ≺⇩S C'"
by fastforce
with wf have "is_class P C'"
by (fastforce dest:subclsS_subcls1 subcls1D class_wf elim:wf_cdecl_supD)
hence "Subobjs⇩R P C' [C']" by (fastforce elim:SubobjsR_Base)
with sup subS have "Subobjs P C [C']" by -(erule Subobjs_Sh, simp)
thus ?thesis by simp
qed
next
case (Cons C'' Cs'')
have IH:"is_subobj P ((C,C'#rev Cs'')) ⟹ Subobjs P C (C'#rev Cs'')"
and subo:"is_subobj P ((C,C'#rev(C''# Cs'')))" by fact+
obtain Ds' where Ds':"Ds' = rev Cs''" by simp
obtain D Ds where DDs:"D#Ds = Ds'@[C'']" by (cases Ds') auto
with Ds' subo have "is_subobj P ((C,C'#D#Ds))" by simp
hence subobl:"is_subobj P ((C,butlast(C'#D#Ds)))"
and subRbl:"P ⊢ last(butlast(C'#D#Ds)) ≺⇩R last(C'#D#Ds)" by simp+
with DDs Ds' have "is_subobj P ((C,C'#rev Cs''))" by (simp del: is_subobj.simps)
with IH have suborev:"Subobjs P C (C'#rev Cs'')" by simp
from subRbl DDs Ds' have subR:"P ⊢ last(C'#rev Cs'') ≺⇩R C''" by simp
with suborev wf show ?case by (fastforce dest:converse_Subobjs_Rep)
qed
lemma isSubobj_Subobjs:
assumes subo:"is_subobj P ((C,Cs))" and wf:"wf_prog wf_md P"
shows "Subobjs P C Cs"
using subo
proof (induct Cs)
case Nil
thus ?case by simp
next
case (Cons C' Cs')
have subo:"is_subobj P ((C,C'#Cs'))" by fact
obtain Cs'' where Cs'':"Cs'' = rev Cs'" by simp
with subo have "is_subobj P ((C,C'#rev Cs''))" by simp
with wf have "Subobjs P C (C'#rev Cs'')" by - (rule isSubobj_Subobjs_rev)
with Cs'' show ?case by simp
qed
lemma isSubobj_eq_Subobjs:
"wf_prog wf_md P ⟹ is_subobj P ((C,Cs)) = (Subobjs P C Cs)"
by(auto elim:isSubobj_Subobjs Subobjs_isSubobj)
lemma subo_trans_subcls:
assumes subo:"Subobjs P C (Cs@ C'#rev Cs')"
shows "∀C'' ∈ set Cs'. (C',C'') ∈ (subcls1 P)⇧+"
using subo
proof (induct Cs')
case Nil
thus ?case by simp
next
case (Cons D Ds)
have IH:"Subobjs P C (Cs @ C' # rev Ds) ⟹
∀C''∈set Ds. (C', C'') ∈ (subcls1 P)⇧+"
and "Subobjs P C (Cs @ C' # rev (D # Ds))" by fact+
hence subo':"Subobjs P C (Cs@ C'#rev Ds @ [D])" by simp
hence "Subobjs P C (Cs@ C'#rev Ds)"
by -(rule appendSubobj,simp_all)
with IH have set:"∀C''∈set Ds. (C', C'') ∈ (subcls1 P)⇧+" by simp
hence revset:"∀C''∈set (rev Ds). (C', C'') ∈ (subcls1 P)⇧+" by simp
have "(C',D) ∈ (subcls1 P)⇧+"
proof (cases "Ds = []")
case True
with subo' have "Subobjs P C (Cs@[C',D])" by simp
thus ?thesis
by (fastforce intro: subclsR_subcls1 Subobjs_subclsR)
next
case False
with revset have hd:"(C',hd Ds) ∈ (subcls1 P)⇧+"
apply -
apply (erule ballE)
apply simp
apply (simp add:in_set_conv_decomp)
apply (erule_tac x="[]" in allE)
apply (erule_tac x="tl Ds" in allE)
apply simp
done
from False subo' have "(hd Ds,D) ∈ (subcls1 P)⇧+"
apply (cases Ds)
apply simp
apply simp
apply (rule r_into_trancl)
apply (rule subclsR_subcls1)
apply (rule_tac Cs="Cs @ C' # rev list" in Subobjs_subclsR)
apply simp
done
with hd show ?thesis by (rule trancl_trans)
qed
with set show ?case by simp
qed
lemma unique1:
assumes subo:"Subobjs P C (Cs@ C'#Cs')" and wf:"wf_prog wf_md P"
shows "C' ∉ set Cs'"
proof -
obtain Ds where Ds:"Ds = rev Cs'" by simp
with subo have "Subobjs P C (Cs@ C'#rev Ds)" by simp
with Ds subo have "∀C'' ∈ set Cs'. (C',C'') ∈ (subcls1 P)⇧+"
by (fastforce dest:subo_trans_subcls)
with wf have "∀C'' ∈ set Cs'. C' ≠ C''"
by (auto dest:subcls_irrefl)
thus ?thesis by fastforce
qed
lemma subo_subcls_trans:
assumes subo:"Subobjs P C (Cs@ C'#Cs')"
shows "∀C'' ∈ set Cs. (C'',C') ∈ (subcls1 P)⇧+"
proof -
from wf subo have "⋀C''. C'' ∈ set Cs ⟹ (C'',C') ∈ (subcls1 P)⇧+"
apply (auto simp:in_set_conv_decomp)
apply (case_tac zs)
apply (fastforce intro: subclsR_subcls1 Subobjs_subclsR)
apply simp
apply (rule_tac b="a" in trancl_rtrancl_trancl)
apply (fastforce intro: subclsR_subcls1 Subobjs_subclsR)
apply (subgoal_tac "P ⊢ a ≼⇧* last (a # list @ [C'])")
apply simp
apply (rule Subobjs_subclass)
apply (rule_tac C="C" and Cs=" ys @[C'']" in Subobjs_Subobjs)
apply (rule_tac Cs'="Cs'" in appendSubobj)
apply simp_all
done
thus ?thesis by fastforce
qed
lemma unique2:
assumes subo:"Subobjs P C (Cs@ C'#Cs')" and wf:"wf_prog wf_md P"
shows "C' ∉ set Cs"
proof -
from subo wf have "∀C'' ∈ set Cs. (C'',C') ∈ (subcls1 P)⇧+"
by (fastforce dest:subo_subcls_trans)
with wf have "∀C'' ∈ set Cs. C' ≠ C''"
by (auto dest:subcls_irrefl)
thus ?thesis by fastforce
qed
lemma mdc_hd_path:
assumes subo:"Subobjs P C Cs" and set:"C ∈ set Cs" and wf:"wf_prog wf_md P"
shows "C = hd Cs"
proof -
from subo set obtain Ds Ds' where Cs:"Cs = Ds@ C#Ds'"
by (auto simp:in_set_conv_decomp)
then obtain Cs' where Cs':"Cs' = rev Ds" by simp
with Cs subo have subo':"Subobjs P C ((rev Cs')@ C#Ds')" by simp
thus ?thesis
proof (cases Cs')
case Nil
with Cs Cs' show ?thesis by simp
next
case (Cons X Xs)
with subo' have suboX:"Subobjs P C ((rev Xs)@[X,C]@Ds')" by simp
hence leq:"P ⊢ X ≺⇧1 C"
by (fastforce intro:subclsR_subcls1 Subobjs_subclsR)
from suboX wf have "P ⊢ C ≼⇧* last ((rev Xs)@[X])"
by (fastforce intro:Subobjs_subclass appendSubobj)
with leq have "(C,C) ∈ (subcls1 P)⇧+" by simp
with wf show ?thesis by (fastforce dest:subcls_irrefl)
qed
qed
lemma mdc_eq_last:
assumes subo:"Subobjs P C Cs" and last:"last Cs = C" and wf:"wf_prog wf_md P"
shows "Cs = [C]"
proof -
from subo have notempty:"Cs ≠ []" by - (drule Subobjs_nonempty)
hence lastset:"last Cs ∈ set Cs"
apply (auto simp add:in_set_conv_decomp)
apply (rule_tac x="butlast Cs" in exI)
apply (rule_tac x="[]" in exI)
apply simp
done
with last have C:"C ∈ set Cs" by simp
with subo wf have hd:"C = hd Cs" by -(rule mdc_hd_path)
then obtain Cs' where Cs':"Cs' = tl Cs" by simp
thus ?thesis
proof (cases Cs')
case Nil
with hd subo Cs' show ?thesis by (fastforce dest:Subobjs_nonempty hd_Cons_tl)
next
case (Cons D Ds)
with Cs' hd notempty have Cs:"Cs=C#D#Ds" by simp
with subo have "Subobjs P C (C#D#Ds)" by simp
with wf have notset:"C ∉ set (D#Ds)" by -(rule_tac Cs="[]" in unique1,simp_all)
from Cs last have "last Cs = last (D#Ds)" by simp
hence "last Cs ∈ set (D#Ds)"
apply (auto simp add:in_set_conv_decomp)
apply (erule_tac x="butlast Ds" in allE)
apply (erule_tac x="[]" in allE)
apply simp
done
with last have "C ∈ set (D#Ds)" by simp
with notset show ?thesis by simp
qed
qed
lemma assumes leq:"P ⊢ C ≼⇧* D" and wf:"wf_prog wf_md P"
shows subcls_leq_path:"∃Cs. P,C ⊢ [C] ⊑ Cs@[D]"
using leq
proof (induct rule:rtrancl.induct)
fix C show "∃Cs. P,C ⊢ [C] ⊑ Cs@[C]" by (rule_tac x="[]" in exI,simp)
next
fix C C' D assume leq':"P ⊢ C ≼⇧* C'" and IH:"∃Cs. P,C ⊢ [C] ⊑ Cs@[C']"
and sub:"P ⊢ C' ≺⇧1 D"
from sub have "is_class P C'" by (rule subcls1_class)
with leq' have "class": "is_class P C" by (rule subcls_is_class)
from IH obtain Cs where steps:"P,C ⊢ [C] ⊑ Cs@[C']" by auto
hence subo:"Subobjs P C (Cs@[C'])" using "class" wf
by (fastforce intro:leq_path_Subobjs)
{ assume "P ⊢ C' ≺⇩R D"
with subo wf have "Subobjs P C (Cs@[C',D])"
by (fastforce dest:converse_Subobjs_Rep)
with subo have "P,C ⊢ (Cs@[C']) ⊏⇧1 (Cs@[C']@[D])"
by (fastforce intro:leq_path_rep) }
moreover
{ assume "P ⊢ C' ≺⇩S D"
with subo have "P,C ⊢ (Cs@[C']) ⊏⇧1 [D]" by (rule leq_path_sh) }
ultimately show "∃Cs. P,C ⊢ [C] ⊑ Cs@[D]" using sub steps
apply (auto dest!:subcls1_subclsR_or_subclsS)
apply (rule_tac x="Cs@[C']" in exI) apply simp
apply (rule_tac x="[]" in exI) apply simp
done
qed
lemma assumes subo:"Subobjs P C (rev Cs)" and wf:"wf_prog wf_md P"
shows subobjs_rel_rev:"P,C ⊢ [C] ⊑ (rev Cs)"
using subo
proof (induct Cs)
case Nil
thus ?case by (fastforce dest:Subobjs_nonempty)
next
case (Cons C' Cs')
have subo':"Subobjs P C (rev (C'#Cs'))"
and IH:"Subobjs P C (rev Cs') ⟹ P,C ⊢ [C] ⊑ rev Cs'" by fact+
from subo' have "class": "is_class P C" by(rule Subobjs_isClass)
show ?case
proof (cases "Cs' = []")
case True hence empty:"Cs' = []" .
with subo' have subo'':"Subobjs P C [C']" by simp
thus ?thesis
proof (cases "C = C'")
case True
with empty show ?thesis by simp
next
case False
with subo'' obtain D D' where leq:"P ⊢ C ≼⇧* D" and subS:"P ⊢ D ≺⇩S D'"
and suboR:"Subobjs⇩R P D' [C']"
by (auto elim:Subobjs.cases dest:hd_SubobjsR)
from suboR have C':"C' = D'" by (fastforce dest:hd_SubobjsR)
from leq wf obtain Ds where steps:"P,C ⊢ [C] ⊑ Ds@[D]"
by (auto dest:subcls_leq_path)
hence suboSteps:"Subobjs P C (Ds@[D])" using "class" wf
apply (induct rule:rtrancl_induct)
apply (erule Subobjs_Base)
apply (auto elim!:leq_path1.cases)
apply (subgoal_tac "Subobjs⇩R P D [D]")
apply (fastforce dest:Subobjs_subclass intro:Subobjs_Sh)
apply (fastforce dest!:subclsSD intro:SubobjsR_Base wf_cdecl_supD
class_wf ShBaseclass_isBaseclass)
done
hence step:"P,C ⊢ (Ds@[D]) ⊏⇧1 [D']" using subS by (rule leq_path_sh)
with steps empty False C' show ?thesis by simp
qed
next
case False
with subo' have subo'':"Subobjs P C (rev Cs')"
by (fastforce intro:butlast_Subobjs)
with IH have steps:"P,C ⊢ [C] ⊑ rev Cs'" by simp
from subo' subo'' have "P,C ⊢ rev Cs' ⊏⇧1 rev (C'#Cs')"
by (fastforce intro:leq_pathRep)
with steps show ?thesis by simp
qed
qed
lemma subobjs_rel:
assumes subo:"Subobjs P C Cs" and wf:"wf_prog wf_md P"
shows "P,C ⊢ [C] ⊑ Cs"
proof -
obtain Cs' where Cs':"Cs' = rev Cs" by simp
with subo have "Subobjs P C (rev Cs')" by simp
hence "P,C ⊢ [C] ⊑ rev Cs'" using wf by (rule subobjs_rel_rev)
with Cs' show ?thesis by simp
qed
lemma assumes wf:"wf_prog wf_md P"
shows leq_path_last:"⟦P,C ⊢ Cs ⊑ Cs'; last Cs = last Cs'⟧ ⟹ Cs = Cs'"
proof(induct rule:rtrancl_induct)
show "Cs = Cs" by simp
next
fix Cs' Cs''
assume leqs:"P,C ⊢ Cs ⊑ Cs'" and leq:"P,C ⊢ Cs' ⊏⇧1 Cs''"
and last:"last Cs = last Cs''"
and IH:"last Cs = last Cs' ⟹ Cs = Cs'"
from leq wf have sup1:"P ⊢ last Cs' ≺⇧1 last Cs''"
by(rule last_leq_path)
{ assume "Cs = Cs'"
with last have eq:"last Cs'' = last Cs'" by simp
with eq wf sup1 have "Cs = Cs''" by(fastforce dest:subcls1_wfD) }
moreover
{ assume "(Cs,Cs') ∈ (leq_path1 P C)⇧+"
hence sub:"(last Cs,last Cs') ∈ (subcls1 P)⇧+" using wf
by(rule last_leq_paths)
with sup1 last have "(last Cs'',last Cs'') ∈ (subcls1 P)⇧+" by simp
with wf have "Cs = Cs''" by(fastforce dest:subcls_irrefl) }
ultimately show "Cs = Cs''" using leqs
by(fastforce dest:rtranclD)
qed
subsection‹Well-formedness and appendPath›
lemma appendPath1:
"⟦Subobjs P C Cs; Subobjs P (last Cs) Ds; last Cs ≠ hd Ds⟧
⟹ Subobjs P C Ds"
apply(subgoal_tac "¬ Subobjs⇩R P (last Cs) Ds")
apply (subgoal_tac "∃C' D. P ⊢ last Cs ≼⇧* C' ∧ P ⊢ C' ≺⇩S D ∧ Subobjs⇩R P D Ds")
apply clarsimp
apply (drule Subobjs_subclass)
apply (subgoal_tac "P ⊢ C ≼⇧* C'")
apply (erule_tac C'="C'" and D="D" in Subobjs_Sh)
apply simp
apply simp
apply fastforce
apply (erule Subobjs_notSubobjsR)
apply simp
apply (fastforce dest:hd_SubobjsR)
done
lemma appendPath2_rev:
assumes subo1:"Subobjs P C Cs" and subo2:"Subobjs P (last Cs) (last Cs#rev Ds)"
and wf:"wf_prog wf_md P"
shows "Subobjs P C (Cs@(tl (last Cs#rev Ds)))"
using subo2
proof (induct Ds)
case Nil
with subo1 show ?case by simp
next
case (Cons D' Ds')
have IH:"Subobjs P (last Cs) (last Cs#rev Ds')
⟹ Subobjs P C (Cs@tl(last Cs#rev Ds'))"
and subo:"Subobjs P (last Cs) (last Cs#rev (D'#Ds'))" by fact+
from subo have "Subobjs P (last Cs) (last Cs#rev Ds')"
by (fastforce intro:butlast_Subobjs)
with IH have subo':"Subobjs P C (Cs@tl(last Cs#rev Ds'))"
by simp
have last:"last(last Cs#rev Ds') = last (Cs@tl(last Cs#rev Ds'))"
by (cases Ds')auto
obtain C' Cs' where C':"C' = last(last Cs#rev Ds')" and
"Cs' = butlast(last Cs#rev Ds')" by simp
then have "Cs' @ [C'] = last Cs # rev Ds'"
using append_butlast_last_id by blast
hence "last Cs#rev (D'#Ds') = Cs'@[C',D']" by simp
with subo have "Subobjs P (last Cs) (Cs'@[C',D'])" by (cases Cs') auto
hence "P ⊢ C' ≺⇩R D'" by - (rule Subobjs_subclsR,simp)
with C' last have "P ⊢ last (Cs@tl(last Cs#rev Ds')) ≺⇩R D'" by simp
with subo' wf have "Subobjs P C ((Cs@tl(last Cs#rev Ds'))@[D'])"
by (erule_tac Cs="(Cs@tl(last Cs#rev Ds'))" in converse_Subobjs_Rep) simp
thus ?case by simp
qed
lemma appendPath2:
assumes subo1:"Subobjs P C Cs" and subo2:"Subobjs P (last Cs) Ds"
and eq:"last Cs = hd Ds" and wf:"wf_prog wf_md P"
shows "Subobjs P C (Cs@(tl Ds))"
using subo2
proof (cases Ds)
case Nil
with subo1 show ?thesis by simp
next
case (Cons D' Ds')
with subo2 eq have subo:"Subobjs P (last Cs) (last Cs#Ds')" by simp
obtain Ds'' where Ds'':"Ds'' = rev Ds'" by simp
with subo have "Subobjs P (last Cs) (last Cs#rev Ds'')" by simp
with subo1 wf have "Subobjs P C (Cs@(tl (last Cs#rev Ds'')))"
by -(rule appendPath2_rev)
with Ds'' eq Cons show ?thesis by simp
qed
lemma Subobjs_appendPath:
"⟦Subobjs P C Cs; Subobjs P (last Cs) Ds;wf_prog wf_md P⟧
⟹ Subobjs P C (Cs@⇩pDs)"
by(fastforce elim:appendPath2 appendPath1 simp:appendPath_def)
subsection‹Path and program size›
lemma assumes subo:"Subobjs P C Cs" and wf:"wf_prog wf_md P"
shows path_contains_classes:"∀C' ∈ set Cs. is_class P C'"
using subo
proof clarsimp
fix C' assume subo:"Subobjs P C Cs" and set:"C' ∈ set Cs"
from set obtain Ds Ds' where Cs:"Cs = Ds@C'#Ds'"
by (fastforce simp:in_set_conv_decomp)
with Cs show "is_class P C'"
proof (cases "Ds = []")
case True
with Cs subo have subo':"Subobjs P C (C'#Ds')" by simp
thus ?thesis by (rule Subobjs.cases,
auto dest:hd_SubobjsR intro:SubobjsR_isClass)
next
case False
then obtain C'' Cs'' where Cs'':"Cs'' = butlast Ds"
and last:"C'' = last Ds" by auto
with False have Ds:"Ds = Cs''@[C'']" by simp
with Cs subo have subo':"Subobjs P C (Cs''@[C'',C']@Ds')"
by simp
hence "P ⊢ C'' ≺⇩R C'" by(fastforce intro:isSubobjs_subclsR Subobjs_isSubobj)
with wf show ?thesis
by (fastforce dest!:subclsRD
intro:wf_cdecl_supD class_wf RepBaseclass_isBaseclass subclsSI)
qed
qed
lemma path_subset_classes:"⟦Subobjs P C Cs; wf_prog wf_md P⟧
⟹ set Cs ⊆ {C. is_class P C}"
by (auto dest:path_contains_classes)
lemma assumes subo:"Subobjs P C (rev Cs)" and wf:"wf_prog wf_md P"
shows rev_path_distinct_classes:"distinct Cs"
using subo
proof (induct Cs)
case Nil thus ?case by(fastforce dest:Subobjs_nonempty)
next
case (Cons C' Cs')
have subo':"Subobjs P C (rev(C'#Cs'))"
and IH:"Subobjs P C (rev Cs') ⟹ distinct Cs'" by fact+
show ?case
proof (cases "Cs' = []")
case True thus ?thesis by simp
next
case False
hence rev:"rev Cs' ≠ []" by simp
from subo' have subo'':"Subobjs P C (rev Cs'@[C'])" by simp
hence "Subobjs P C (rev Cs')" using rev wf
by(fastforce dest:appendSubobj)
with IH have dist:"distinct Cs'" by simp
from subo'' wf have "C' ∉ set (rev Cs')"
by(fastforce dest:unique2)
with dist show ?thesis by simp
qed
qed
lemma assumes subo:"Subobjs P C Cs" and wf:"wf_prog wf_md P"
shows path_distinct_classes:"distinct Cs"
proof -
obtain Cs' where Cs':"Cs' = rev Cs" by simp
with subo have "Subobjs P C (rev Cs')" by simp
with wf have "distinct Cs'"
by -(rule rev_path_distinct_classes)
with Cs' show ?thesis by simp
qed
lemma assumes wf:"wf_prog wf_md P"
shows prog_length:"length P = card {C. is_class P C}"
proof -
from wf have dist_fst:"distinct_fst P" by (simp add:wf_prog_def)
hence "distinct P" by (simp add:distinct_fst_def,induct P,auto)
hence card_set:"card (set P) = length P" by (rule distinct_card)
from dist_fst have set:"{C. is_class P C} = fst ` (set P)"
by (simp add:is_class_def class_def,auto simp:distinct_fst_def,
auto dest:map_of_eq_Some_iff intro!:image_eqI)
from dist_fst have "card(fst ` (set P)) = card (set P)"
by(auto intro:card_image simp:distinct_map distinct_fst_def)
with card_set set show ?thesis by simp
qed
lemma assumes subo:"Subobjs P C Cs" and wf:"wf_prog wf_md P"
shows path_length:"length Cs ≤ length P"
proof -
from subo wf have "distinct Cs" by (rule path_distinct_classes)
hence card_eq_length:"card (set Cs) = length Cs" by (rule distinct_card)
from subo wf have "card (set Cs) ≤ card {C. is_class P C}"
by (auto dest:path_subset_classes intro:card_mono finite_is_class)
with card_eq_length have "length Cs ≤ card {C. is_class P C}" by simp
with wf show ?thesis by(fastforce dest:prog_length)
qed
lemma empty_path_empty_set:"{Cs. Subobjs P C Cs ∧ length Cs ≤ 0} = {}"
by (auto dest:Subobjs_nonempty)
lemma split_set_path_length:"{Cs. Subobjs P C Cs ∧ length Cs ≤ Suc(n)} =
{Cs. Subobjs P C Cs ∧ length Cs ≤ n} ∪ {Cs. Subobjs P C Cs ∧ length Cs = Suc(n)}"
by auto
lemma empty_list_set:"{xs. set xs ⊆ F ∧ xs = []} = {[]}"
by auto
lemma suc_n_union_of_union:"{xs. set xs ⊆ F ∧ length xs = Suc n} = (UN x:F. UN xs : {xs. set xs ≤ F ∧ length xs = n}. {x#xs})"
by (auto simp:length_Suc_conv)
lemma max_length_finite_set:"finite F ⟹ finite{xs. set xs <= F ∧ length xs = n}"
by(induct n,simp add:empty_list_set, simp add:suc_n_union_of_union)
lemma path_length_n_finite_set:
"wf_prog wf_md P ⟹ finite{Cs. Subobjs P C Cs ∧ length Cs = n}"
by (rule_tac B="{Cs. set Cs <= {C. is_class P C} ∧ length Cs = n}" in finite_subset,
auto dest:path_contains_classes intro:max_length_finite_set simp:finite_is_class)
lemma path_finite_leq:
"wf_prog wf_md P ⟹ finite{Cs. Subobjs P C Cs ∧ length Cs ≤ length P}"
by (induct ("length P"), simp only:empty_path_empty_set,
auto intro:path_length_n_finite_set simp:split_set_path_length)
lemma path_finite:"wf_prog wf_md P ⟹ finite{Cs. Subobjs P C Cs}"
by (subgoal_tac "{Cs. Subobjs P C Cs} =
{Cs. Subobjs P C Cs ∧ length Cs ≤ length P}",
auto intro:path_finite_leq path_length)
subsection‹Well-formedness and Path›
lemma path_via_reverse:
assumes path_via:"P ⊢ Path C to D via Cs" and wf:"wf_prog wf_md P"
shows "∀Cs'. P ⊢ Path D to C via Cs' ⟶ Cs = [C] ∧ Cs' = [C] ∧ C = D"
proof -
from path_via have subo:"Subobjs P C Cs" and last:"last Cs = D"
by(simp add:path_via_def)+
hence leq:"P ⊢ C ≼⇧* D" by(fastforce dest:Subobjs_subclass)
{ fix Cs' assume "P ⊢ Path D to C via Cs'"
hence subo':"Subobjs P D Cs'" and last':"last Cs' = C"
by(simp add:path_via_def)+
hence leq':"P ⊢ D ≼⇧* C" by(fastforce dest:Subobjs_subclass)
with leq wf have CeqD:"C = D" by(rule subcls_asym2)
moreover have Cs:"Cs = [C]" using CeqD subo last wf by(fastforce intro:mdc_eq_last)
moreover have "Cs' = [C]" using CeqD subo' last' wf by(fastforce intro:mdc_eq_last)
ultimately have "Cs = [C] ∧ Cs' = [C] ∧ C = D" by simp }
thus ?thesis by blast
qed
lemma path_hd_appendPath:
assumes path:"P,C ⊢ Cs ⊑ Cs'@⇩pCs" and last:"last Cs' = hd Cs"
and notemptyCs:"Cs ≠ []" and notemptyCs':"Cs' ≠ []" and wf:"wf_prog wf_md P"
shows "Cs' = [hd Cs]"
using path
proof -
from path notemptyCs last have path2:"P,C ⊢ Cs ⊑ Cs'@ tl Cs"
by (simp add:appendPath_def)
thus ?thesis
proof (auto dest!:rtranclD)
assume "Cs = Cs'@ tl Cs"
with notemptyCs show "Cs' = [hd Cs]" by (rule app_hd_tl)
next
assume trancl:"(Cs,Cs'@ tl Cs) ∈ (leq_path1 P C)⇧+"
from notemptyCs' last have butlastLast:"Cs' = butlast Cs' @ [hd Cs]"
by -(drule append_butlast_last_id,simp)
with trancl have trancl':"(Cs, (butlast Cs' @ [hd Cs]) @ tl Cs) ∈ (leq_path1 P C)⇧+"
by simp
from notemptyCs have "(butlast Cs' @ [hd Cs]) @ tl Cs = butlast Cs' @ Cs"
by simp
with trancl' have "(Cs, butlast Cs' @ Cs) ∈ (leq_path1 P C)⇧+" by simp
hence "(last Cs, last (butlast Cs' @ Cs)) ∈ (subcls1 P)⇧+" using wf
by (rule last_leq_paths)
with notemptyCs have "(last Cs, last Cs) ∈ (subcls1 P)⇧+"
by -(drule_tac xs="butlast Cs'" in last_appendR,simp)
with wf show ?thesis by (auto dest:subcls_irrefl)
qed
qed
lemma path_via_C: "⟦P ⊢ Path C to C via Cs; wf_prog wf_md P⟧ ⟹ Cs = [C]"
by (fastforce intro:mdc_eq_last simp:path_via_def)
lemma assumes wf:"wf_prog wf_md P"
and path_via:"P ⊢ Path last Cs to C via Cs'"
and path_via':"P ⊢ Path last Cs to C via Cs''"
and appendPath:"Cs = Cs@⇩pCs'"
shows appendPath_path_via:"Cs = Cs@⇩pCs''"
proof -
from path_via have notempty:"Cs' ≠ []"
by(fastforce intro!:Subobjs_nonempty simp:path_via_def)
{ assume eq:"last Cs = hd Cs'"
and Cs:"Cs = Cs@tl Cs'"
from Cs have "tl Cs' = []" by simp
with eq notempty have "Cs' = [last Cs]"
by -(drule hd_Cons_tl,simp) }
moreover
{ assume "Cs = Cs'"
with wf path_via have "Cs' = [last Cs]"
by(fastforce intro:mdc_eq_last simp:path_via_def) }
ultimately have eq:"Cs' = [last Cs]" using appendPath
by(simp add:appendPath_def,split if_split_asm,simp_all)
with path_via have "C = last Cs"
by(simp add:path_via_def)
with wf path_via' have "Cs'' = [last Cs]"
by simp(rule path_via_C)
thus ?thesis by (simp add:appendPath_def)
qed
lemma subo_no_path:
assumes subo:"Subobjs P C' (Cs @ C#Cs')" and wf:"wf_prog wf_md P"
and notempty:"Cs' ≠ []"
shows "¬ P ⊢ Path last Cs' to C via Ds"
proof
assume "P ⊢ Path last Cs' to C via Ds"
hence subo':"Subobjs P (last Cs') Ds" and last:"last Ds = C"
by (auto simp:path_via_def)
hence notemptyDs:"Ds ≠ []" by -(drule Subobjs_nonempty)
then obtain D' Ds' where D'Ds':"Ds = D'#Ds'" by(cases Ds)auto
from subo have suboC:"Subobjs P C (C#Cs')" by (rule Subobjs_Subobjs)
with wf subo' notempty have suboapp:"Subobjs P C ((C#Cs')@⇩pDs)"
by -(rule Subobjs_appendPath,simp_all)
with notemptyDs last have last':"last ((C#Cs')@⇩pDs) = C"
by -(drule_tac Cs'="(C#Cs')" in appendPath_last,simp)
from notemptyDs have "(C#Cs')@⇩pDs ≠ []"
by (simp add:appendPath_def)
with last' have "C ∈ set ((C#Cs')@⇩pDs)"
apply (auto simp add:in_set_conv_decomp)
apply (rule_tac x="butlast((C#Cs')@⇩pDs)" in exI)
apply (rule_tac x="[]" in exI)
apply (drule append_butlast_last_id)
apply simp
done
with suboapp wf have hd:"C = hd ((C#Cs')@⇩pDs)" by -(rule mdc_hd_path)
thus "False"
proof (cases "last (C#Cs') = hd Ds")
case True
hence eq:"(C#Cs')@⇩pDs = (C#Cs')@(tl Ds)" by (simp add:appendPath_def)
show ?thesis
proof (cases Ds')
case Nil
with D'Ds' have Ds:"Ds = [D']" by simp
with last have "C = D'" by simp
with True notempty Ds have "last (C#Cs') = C" by simp
with notempty have "last Cs' = C" by simp
with notempty have Cset:"C ∈ set Cs'"
apply (auto simp add:in_set_conv_decomp)
apply (rule_tac x="butlast Cs'" in exI)
apply (rule_tac x="[]" in exI)
apply (drule append_butlast_last_id)
apply simp
done
from subo wf have "C ∉ set Cs'" by (rule unique1)
with Cset show ?thesis by simp
next
case (Cons X Xs)
with D'Ds' have tlnotempty:"tl Ds ≠ []" by simp
with Cons last D'Ds' have "last (tl Ds) = C" by simp
with tlnotempty have "C ∈ set (tl Ds)"
apply (auto simp add:in_set_conv_decomp)
apply (rule_tac x="butlast (tl Ds)" in exI)
apply (rule_tac x="[]" in exI)
apply (drule append_butlast_last_id)
apply simp
done
hence Cset:"C ∈ set (Cs'@(tl Ds))" by simp
from suboapp eq wf have "C ∉ set (Cs'@(tl Ds))"
by (subgoal_tac "Subobjs P C (C#(Cs'@(tl Ds)))",
rule_tac Cs="[]" in unique1,simp_all)
with Cset show ?thesis by simp
qed
next
case False
with notemptyDs have eq:"(C#Cs')@⇩pDs = Ds" by (simp add:appendPath_def)
with subo' last have lastleq:"P ⊢ last Cs' ≼⇧* C"
by (fastforce dest:Subobjs_subclass)
from notempty obtain X Xs where X:"X = last Cs'" and "Xs = butlast Cs'"
by auto
with notempty have XXs:"Cs' = Xs@[X]" by simp
hence CleqX:"(C,X) ∈ (subcls1 P)⇧+"
proof (cases Xs)
case Nil
with suboC XXs have "Subobjs P C [C,X]" by simp
thus ?thesis
apply -
apply (rule r_into_trancl)
apply (rule subclsR_subcls1)
apply (rule_tac Cs="[]" in Subobjs_subclsR)
apply simp
done
next
case (Cons Y Ys)
with suboC XXs have subo'':"Subobjs P C ([C,Y]@Ys@[X])" by simp
hence plus:"(C,Y) ∈ (subcls1 P)⇧+"
apply -
apply (rule r_into_trancl)
apply (rule subclsR_subcls1)
apply (rule_tac Cs="[]" in Subobjs_subclsR)
apply simp
done
from subo'' have "P ⊢ Y ≼⇧* X"
apply -
apply (subgoal_tac "Subobjs P C ([C]@Y#(Ys@[X]))")
apply (drule Subobjs_Subobjs)
apply (drule_tac C="Y" in Subobjs_subclass) apply simp_all
done
with plus show ?thesis by (fastforce elim:trancl_rtrancl_trancl)
qed
from lastleq X have leq:"P ⊢ X ≼⇧* C" by simp
with CleqX have "(C,C) ∈ (subcls1 P)⇧+"
by (rule trancl_rtrancl_trancl)
with wf show ?thesis by (fastforce dest:subcls_irrefl)
qed
qed
lemma leq_implies_path:
assumes leq:"P ⊢ C ≼⇧* D" and "class": "is_class P C"
and wf:"wf_prog wf_md P"
shows "∃Cs. P ⊢ Path C to D via Cs"
using leq "class"
proof(induct rule:rtrancl.induct)
fix C assume "is_class P C"
thus "∃Cs. P ⊢ Path C to C via Cs"
by (rule_tac x="[C]" in exI,fastforce intro:Subobjs_Base simp:path_via_def)
next
fix C C' D assume CleqC':"P ⊢ C ≼⇧* C'" and C'leqD:"P ⊢ C' ≺⇧1 D"
and classC:"is_class P C" and IH:"is_class P C ⟹ ∃Cs. P ⊢ Path C to C' via Cs"
from IH[OF classC] obtain Cs where subo:"Subobjs P C Cs" and last:"last Cs = C'"
by (auto simp:path_via_def)
with C'leqD show "∃Cs. P ⊢ Path C to D via Cs"
proof (auto dest!:subcls1_subclsR_or_subclsS)
assume "P ⊢ last Cs ≺⇩R D"
with subo have "Subobjs P C (Cs@[D])" using wf
by (rule converse_Subobjs_Rep)
thus ?thesis by (fastforce simp:path_via_def)
next
assume subS:"P ⊢ last Cs ≺⇩S D"
from CleqC' last have Cleqlast:"P ⊢ C ≼⇧* last Cs" by simp
from subS have classLast:"is_class P (last Cs)"
by (auto intro:subcls1_class subclsS_subcls1)
then obtain Bs fs ms where "class P (last Cs) = Some(Bs,fs,ms)"
by (fastforce simp:is_class_def)
hence classD:"is_class P D" using subS wf
by (auto intro:wf_cdecl_supD dest:class_wf dest!:subclsSD
elim:ShBaseclass_isBaseclass)
with Cleqlast subS have "Subobjs P C [D]"
by (fastforce intro:Subobjs_Sh SubobjsR_Base)
thus ?thesis by (fastforce simp:path_via_def)
qed
qed
lemma least_method_implies_path_unique:
assumes least:"P ⊢ C has least M = (Ts,T,m) via Cs" and wf:"wf_prog wf_md P"
shows "P ⊢ Path C to (last Cs) unique"
proof (auto simp add:path_unique_def)
from least have "Subobjs P C Cs"
by (simp add:LeastMethodDef_def MethodDefs_def)
thus "∃Cs'. Subobjs P C Cs' ∧ last Cs' = last Cs"
by fastforce
next
fix Cs' Cs''
assume suboCs':"Subobjs P C Cs'" and suboCs'':"Subobjs P C Cs''"
and lastCs':"last Cs' = last Cs" and lastCs'':"last Cs'' = last Cs"
from suboCs' have notemptyCs':"Cs' ≠ []" by (rule Subobjs_nonempty)
from suboCs'' have notemptyCs'':"Cs'' ≠ []" by (rule Subobjs_nonempty)
from least have suboCs:"Subobjs P C Cs"
and all:"∀Ds. Subobjs P C Ds ∧
(∃Ts T m Bs ms. (∃fs. class P (last Ds) = Some (Bs, fs, ms)) ∧
map_of ms M = Some(Ts,T,m)) ⟶ P,C ⊢ Cs ⊑ Ds"
by (auto simp:LeastMethodDef_def MethodDefs_def)
from least obtain Bs fs ms T Ts m where
"class": "class P (last Cs) = Some(Bs, fs, ms)" and map:"map_of ms M = Some(Ts,T,m)"
by (auto simp:LeastMethodDef_def MethodDefs_def intro:that)
from suboCs' lastCs' "class" map all have pathCs':"P,C ⊢ Cs ⊑ Cs'"
by simp
with wf lastCs' have eq:"Cs = Cs'" by(fastforce intro:leq_path_last)
from suboCs'' lastCs'' "class" map all have pathCs'':"P,C ⊢ Cs ⊑ Cs''"
by simp
with wf lastCs'' have "Cs = Cs''" by(fastforce intro:leq_path_last)
with eq show "Cs' = Cs''" by simp
qed
lemma least_field_implies_path_unique:
assumes least:"P ⊢ C has least F:T via Cs" and wf:"wf_prog wf_md P"
shows "P ⊢ Path C to (hd Cs) unique"
proof (auto simp add:path_unique_def)
from least have "Subobjs P C Cs"
by (simp add:LeastFieldDecl_def FieldDecls_def)
hence "Subobjs P C ([hd Cs]@tl Cs)"
by - (frule Subobjs_nonempty,simp)
with wf have "Subobjs P C [hd Cs]"
by (fastforce intro:appendSubobj)
thus "∃Cs'. Subobjs P C Cs' ∧ last Cs' = hd Cs"
by fastforce
next
fix Cs' Cs''
assume suboCs':"Subobjs P C Cs'" and suboCs'':"Subobjs P C Cs''"
and lastCs':"last Cs' = hd Cs" and lastCs'':"last Cs'' = hd Cs"
from suboCs' have notemptyCs':"Cs' ≠ []" by (rule Subobjs_nonempty)
from suboCs'' have notemptyCs'':"Cs'' ≠ []" by (rule Subobjs_nonempty)
from least have suboCs:"Subobjs P C Cs"
and all:"∀Ds. Subobjs P C Ds ∧
(∃T Bs fs. (∃ms. class P (last Ds) = Some (Bs, fs, ms)) ∧
map_of fs F = Some T) ⟶ P,C ⊢ Cs ⊑ Ds"
by (auto simp:LeastFieldDecl_def FieldDecls_def)
from least obtain Bs fs ms T where
"class": "class P (last Cs) = Some(Bs, fs, ms)" and map:"map_of fs F = Some T"
by (auto simp:LeastFieldDecl_def FieldDecls_def)
from suboCs have notemptyCs:"Cs ≠ []" by (rule Subobjs_nonempty)
from suboCs notemptyCs have suboHd:"Subobjs P (hd Cs) (hd Cs#tl Cs)"
by -(rule_tac C="C" and Cs="[]" in Subobjs_Subobjs,simp)
with suboCs' notemptyCs lastCs' wf have suboCs'App:"Subobjs P C (Cs'@⇩pCs)"
by -(rule Subobjs_appendPath,simp_all)
from suboHd suboCs'' notemptyCs lastCs'' wf
have suboCs''App:"Subobjs P C (Cs''@⇩pCs)"
by -(rule Subobjs_appendPath,simp_all)
from suboCs'App all "class" map notemptyCs have pathCs':"P,C ⊢ Cs ⊑ Cs'@⇩pCs"
by -(erule_tac x="Cs'@⇩pCs" in allE,drule_tac Cs'="Cs'" in appendPath_last,simp)
from suboCs''App all "class" map notemptyCs have pathCs'':"P,C ⊢ Cs ⊑ Cs''@⇩pCs"
by -(erule_tac x="Cs''@⇩pCs" in allE,drule_tac Cs'="Cs''" in appendPath_last,simp)
from pathCs' lastCs' notemptyCs notemptyCs' wf have Cs':"Cs' = [hd Cs]"
by (rule path_hd_appendPath)
from pathCs'' lastCs'' notemptyCs notemptyCs'' wf have "Cs'' = [hd Cs]"
by (rule path_hd_appendPath)
with Cs' show "Cs' = Cs''" by simp
qed
lemma least_field_implies_path_via_hd:
"⟦P ⊢ C has least F:T via Cs; wf_prog wf_md P⟧
⟹ P ⊢ Path C to (hd Cs) via [hd Cs]"
apply (simp add:LeastFieldDecl_def FieldDecls_def)
apply clarsimp
apply (simp add:path_via_def)
apply (frule Subobjs_nonempty)
apply (rule_tac Cs'="tl Cs" in appendSubobj)
apply auto
done
lemma path_C_to_C_unique:
"⟦wf_prog wf_md P; is_class P C⟧ ⟹ P ⊢ Path C to C unique"
apply (unfold path_unique_def)
apply (rule_tac a="[C]" in ex1I)
apply (auto intro:Subobjs_Base mdc_eq_last)
done
lemma leqR_SubobjsR:"⟦(C,D) ∈ (subclsR P)⇧*; is_class P C; wf_prog wf_md P⟧
⟹ ∃Cs. Subobjs⇩R P C (Cs@[D])"
apply (induct rule:rtrancl_induct)
apply (drule SubobjsR_Base)
apply (rule_tac x="[]" in exI)
apply simp
apply (auto dest:converse_SubobjsR_Rep)
done
lemma assumes path_unique:"P ⊢ Path C to D unique" and leq:"P ⊢ C ≼⇧* C'"
and leqR:"(C',D) ∈ (subclsR P)⇧*" and wf:"wf_prog wf_md P"
shows "P ⊢ Path C to C' unique"
proof -
from path_unique have "is_class P C"
by (auto intro:Subobjs_isClass simp:path_unique_def)
with leq wf obtain Cs where path_via:"P ⊢ Path C to C' via Cs"
by (auto dest:leq_implies_path)
with wf have classC':"is_class P C'"
by (fastforce intro:Subobj_last_isClass simp:path_via_def)
with leqR wf obtain Cs' where subo:"Subobjs⇩R P C' Cs'" and last:"last Cs' = D"
by (auto dest:leqR_SubobjsR)
hence hd:"hd Cs' = C'"
by (fastforce dest:hd_SubobjsR)
with path_via subo wf have suboApp:"Subobjs P C (Cs@tl Cs')"
by (auto dest!:Subobjs_Rep dest:Subobjs_appendPath
simp:path_via_def appendPath_def)
hence last':"last (Cs@tl Cs') = D"
proof (cases "tl Cs' = []")
case True
with subo hd last have "C' = D"
by (subgoal_tac "Cs' = [C']",auto dest!:SubobjsR_nonempty hd_Cons_tl)
with path_via have "last Cs = D"
by (auto simp:path_via_def)
with True show ?thesis by simp
next
case False
from subo have Cs':"Cs' = hd Cs'#tl Cs'"
by (auto dest:SubobjsR_nonempty)
from False have "last(hd Cs'#tl Cs') = last (tl Cs')"
by (rule last_ConsR)
with False Cs' last show ?thesis by simp
qed
with path_unique suboApp
have all:"∀Ds. Subobjs P C Ds ∧ last Ds = D ⟶ Ds = Cs@tl Cs'"
by (auto simp add:path_unique_def)
{ fix Cs'' assume path_via2:"P ⊢ Path C to C' via Cs''" and noteq:"Cs'' ≠ Cs"
with suboApp have "last (Cs''@tl Cs') = D"
proof (cases "tl Cs' = []")
case True
with subo hd last have "C' = D"
by (subgoal_tac "Cs' = [C']",auto dest!:SubobjsR_nonempty hd_Cons_tl)
with path_via2 have "last Cs'' = D"
by (auto simp:path_via_def)
with True show ?thesis by simp
next
case False
from subo have Cs':"Cs' = hd Cs'#tl Cs'"
by (auto dest:SubobjsR_nonempty)
from False have "last(hd Cs'#tl Cs') = last (tl Cs')"
by (rule last_ConsR)
with False Cs' last show ?thesis by simp
qed
with path_via2 noteq have False using all subo hd wf
apply (auto simp:path_via_def)
apply (drule Subobjs_Rep)
apply (drule Subobjs_appendPath)
apply (auto simp:appendPath_def)
done }
with path_via show ?thesis
by (auto simp:path_via_def path_unique_def)
qed
subsection‹Well-formedness and member lookup›
lemma has_path_has:
"⟦P ⊢ Path D to C via Ds; P ⊢ C has M = (Ts,T,m) via Cs; wf_prog wf_md P⟧
⟹ P ⊢ D has M = (Ts,T,m) via Ds@⇩pCs"
by (clarsimp simp:HasMethodDef_def MethodDefs_def,frule Subobjs_nonempty,
drule_tac Cs'="Ds" in appendPath_last,
fastforce intro:Subobjs_appendPath simp:path_via_def)
lemma has_least_wf_mdecl:
"⟦ wf_prog wf_md P; P ⊢ C has least M = m via Cs ⟧
⟹ wf_mdecl wf_md P (last Cs) (M,m)"
by(fastforce dest:visible_methods_exist class_wf map_of_SomeD
simp:LeastMethodDef_def wf_cdecl_def)
lemma has_overrider_wf_mdecl:
"⟦ wf_prog wf_md P; P ⊢ (C,Cs) has overrider M = m via Cs' ⟧
⟹ wf_mdecl wf_md P (last Cs') (M,m)"
by(fastforce dest:visible_methods_exist map_of_SomeD class_wf
simp:FinalOverriderMethodDef_def OverriderMethodDefs_def
MinimalMethodDefs_def wf_cdecl_def)
lemma select_method_wf_mdecl:
"⟦ wf_prog wf_md P; P ⊢ (C,Cs) selects M = m via Cs' ⟧
⟹ wf_mdecl wf_md P (last Cs') (M,m)"
by(fastforce elim:SelectMethodDef.induct
intro:has_least_wf_mdecl has_overrider_wf_mdecl)
lemma wf_sees_method_fun:
"⟦P ⊢ C has least M = mthd via Cs; P ⊢ C has least M = mthd' via Cs';
wf_prog wf_md P⟧
⟹ mthd = mthd' ∧ Cs = Cs'"
apply (auto simp:LeastMethodDef_def)
apply (erule_tac x="(Cs', mthd')" in ballE)
apply (erule_tac x="(Cs, mthd)" in ballE)
apply auto
apply (drule leq_path_asym2) apply simp_all
apply (rule sees_methods_fun) apply simp_all
apply (erule_tac x="(Cs', mthd')" in ballE)
apply (erule_tac x="(Cs, mthd)" in ballE)
apply (auto intro:leq_path_asym2)
done
lemma wf_select_method_fun:
assumes wf:"wf_prog wf_md P"
shows "⟦P ⊢ (C,Cs) selects M = mthd via Cs'; P ⊢ (C,Cs) selects M = mthd' via Cs''⟧
⟹ mthd = mthd' ∧ Cs' = Cs''"
proof(induct rule:SelectMethodDef.induct)
case (dyn_unique C M mthd Cs' Cs)
have "P ⊢ (C, Cs) selects M = mthd' via Cs''"
and "P ⊢ C has least M = mthd via Cs'" by fact+
thus ?case
proof(induct rule:SelectMethodDef.induct)
case (dyn_unique D M' mthd' Ds' Ds)
have "P ⊢ D has least M' = mthd' via Ds'"
and "P ⊢ D has least M' = mthd via Cs'" by fact+
with wf show ?case
by -(rule wf_sees_method_fun,simp_all)
next
case (dyn_ambiguous D M' Ds mthd' Ds')
have "∀mthd Cs'. ¬ P ⊢ D has least M' = mthd via Cs'"
and "P ⊢ D has least M' = mthd via Cs'" by fact+
thus ?case by blast
qed
next
case (dyn_ambiguous C M Cs mthd Cs')
have "P ⊢ (C, Cs) selects M = mthd' via Cs''"
and "P ⊢ (C, Cs) has overrider M = mthd via Cs'"
and "∀mthd Cs'. ¬ P ⊢ C has least M = mthd via Cs'" by fact+
thus ?case
proof(induct rule:SelectMethodDef.induct)
case (dyn_unique D M' mthd' Ds' Ds)
have "P ⊢ D has least M' = mthd' via Ds'"
and "∀mthd Cs'. ¬ P ⊢ D has least M' = mthd via Cs'" by fact+
thus ?case by blast
next
case (dyn_ambiguous D M' Ds mthd' Ds')
have "P ⊢ (D, Ds) has overrider M' = mthd' via Ds'"
and "P ⊢ (D, Ds) has overrider M' = mthd via Cs'" by fact+
thus ?case by(fastforce dest:overrider_method_fun)
qed
qed
lemma least_field_is_type:
assumes field:"P ⊢ C has least F:T via Cs" and wf:"wf_prog wf_md P"
shows "is_type P T"
proof -
from field have "(Cs,T) ∈ FieldDecls P C F"
by (simp add:LeastFieldDecl_def)
from this obtain Bs fs ms
where "map_of fs F = Some T"
and "class": "class P (last Cs) = Some (Bs,fs,ms)"
by (auto simp add:FieldDecls_def)
hence "(F,T) ∈ set fs" by (simp add:map_of_SomeD)
with "class" wf show ?thesis
by(fastforce dest!: class_wf simp: wf_cdecl_def wf_fdecl_def)
qed
lemma least_method_is_type:
assumes "method":"P ⊢ C has least M = (Ts,T,m) via Cs" and wf:"wf_prog wf_md P"
shows "is_type P T"
proof -
from "method" have "(Cs,Ts,T,m) ∈ MethodDefs P C M"
by (simp add:LeastMethodDef_def)
from this obtain Bs fs ms
where "map_of ms M = Some(Ts,T,m)"
and "class": "class P (last Cs) = Some (Bs,fs,ms)"
by (auto simp add:MethodDefs_def)
hence "(M,Ts,T,m) ∈ set ms" by (simp add:map_of_SomeD)
with "class" wf show ?thesis
by(fastforce dest!: class_wf simp: wf_cdecl_def wf_mdecl_def)
qed
lemma least_overrider_is_type:
assumes "method":"P ⊢ (C,Cs) has overrider M = (Ts,T,m) via Cs'"
and wf:"wf_prog wf_md P"
shows "is_type P T"
proof -
from "method" have "(Cs',Ts,T,m) ∈ MethodDefs P C M"
by(clarsimp simp:FinalOverriderMethodDef_def OverriderMethodDefs_def
MinimalMethodDefs_def)
from this obtain Bs fs ms
where "map_of ms M = Some(Ts,T,m)"
and "class": "class P (last Cs') = Some (Bs,fs,ms)"
by (auto simp add:MethodDefs_def)
hence "(M,Ts,T,m) ∈ set ms" by (simp add:map_of_SomeD)
with "class" wf show ?thesis
by(fastforce dest!: class_wf simp: wf_cdecl_def wf_mdecl_def)
qed
lemma select_method_is_type:
"⟦ P ⊢ (C,Cs) selects M = (Ts,T,m) via Cs'; wf_prog wf_md P⟧ ⟹ is_type P T"
by(auto elim:SelectMethodDef.cases
intro:least_method_is_type least_overrider_is_type)
lemma base_subtype:
"⟦wf_cdecl wf_md P (C,Bs,fs,ms); C' ∈ baseClasses Bs;
P ⊢ C' has M = (Ts',T',m') via Cs@⇩p[D]; (M,Ts,T,m)∈set ms⟧
⟹ Ts' = Ts ∧ P ⊢ T ≤ T'"
apply (simp add:wf_cdecl_def)
apply clarsimp
apply (rotate_tac -1)
apply (erule_tac x="C'" in ballE)
apply clarsimp
apply (rotate_tac -1)
apply (erule_tac x="(M, Ts, T, m)" in ballE)
apply clarsimp
apply (erule_tac x="Ts'" in allE)
apply (erule_tac x="T'" in allE)
apply (auto simp:HasMethodDef_def)
apply (erule_tac x="fst m'" in allE)
apply (erule_tac x="snd m'" in allE)
apply (erule_tac x="Cs@⇩p[D]" in allE)
apply simp
apply (erule_tac x="fst m'" in allE)
apply (erule_tac x="snd m'" in allE)
apply (erule_tac x="Cs@⇩p[D]" in allE)
apply simp
done
lemma subclsPlus_subtype:
assumes classD:"class P D = Some(Bs',fs',ms')"
and mapMs':"map_of ms' M = Some(Ts',T',m')"
and leq:"(C,D) ∈ (subcls1 P)⇧+" and wf:"wf_prog wf_md P"
shows "∀Bs fs ms Ts T m. class P C = Some(Bs,fs,ms) ∧ map_of ms M = Some(Ts,T,m)
⟶ Ts' = Ts ∧ P ⊢ T ≤ T'"
using leq classD mapMs'
proof (erule_tac a="C" and b="D" in converse_trancl_induct)
fix C
assume CleqD:"P ⊢ C ≺⇧1 D" and classD1:"class P D = Some(Bs',fs',ms')"
{ fix Bs fs ms Ts T m
assume classC:"class P C = Some(Bs,fs,ms)" and mapMs:"map_of ms M = Some(Ts,T,m)"
from classD1 mapMs' have hasViaD:"P ⊢ D has M = (Ts',T',m') via [D]"
by (fastforce intro:Subobjs_Base simp:HasMethodDef_def MethodDefs_def is_class_def)
from CleqD classC have base:"D ∈ baseClasses Bs"
by (fastforce dest:subcls1D)
from classC wf have cdecl:"wf_cdecl wf_md P (C,Bs,fs,ms)"
by (rule class_wf)
from classC mapMs have "(M,Ts,T,m)∈set ms"
by -(drule map_of_SomeD)
with cdecl base hasViaD have "Ts' = Ts ∧ P ⊢ T ≤ T'"
by -(rule_tac Cs="[D]" in base_subtype,auto simp:appendPath_def) }
thus "∀Bs fs ms Ts T m. class P C = Some(Bs, fs, ms) ∧ map_of ms M = Some(Ts,T,m)
⟶ Ts' = Ts ∧ P ⊢ T ≤ T'" by blast
next
fix C C'
assume classD1:"class P D = Some(Bs',fs',ms')" and CleqC':"P ⊢ C ≺⇧1 C'"
and subcls:"(C',D) ∈ (subcls1 P)⇧+"
and IH:"∀Bs fs ms Ts T m. class P C' = Some(Bs,fs,ms) ∧
map_of ms M = Some(Ts,T,m) ⟶
Ts' = Ts ∧ P ⊢ T ≤ T'"
{ fix Bs fs ms Ts T m
assume classC:"class P C = Some(Bs,fs,ms)" and mapMs:"map_of ms M = Some(Ts,T,m)"
from classD1 mapMs' have hasViaD:"P ⊢ D has M = (Ts',T',m') via [D]"
by (fastforce intro:Subobjs_Base simp:HasMethodDef_def MethodDefs_def is_class_def)
from subcls have C'leqD:"P ⊢ C' ≼⇧* D" by simp
from classC wf CleqC' have "is_class P C'"
by (fastforce intro:wf_cdecl_supD class_wf dest:subcls1D)
with C'leqD wf obtain Cs where "P ⊢ Path C' to D via Cs"
by (auto dest!:leq_implies_path simp:is_class_def)
hence hasVia:"P ⊢ C' has M = (Ts',T',m') via Cs@⇩p[D]" using hasViaD wf
by (rule has_path_has)
from CleqC' classC have base:"C' ∈ baseClasses Bs"
by (fastforce dest:subcls1D)
from classC wf have cdecl:"wf_cdecl wf_md P (C,Bs,fs,ms)"
by (rule class_wf)
from classC mapMs have "(M,Ts,T,m)∈set ms"
by -(drule map_of_SomeD)
with cdecl base hasVia have "Ts' = Ts ∧ P ⊢ T ≤ T'"
by(rule base_subtype) }
thus "∀Bs fs ms Ts T m. class P C = Some(Bs, fs, ms) ∧ map_of ms M = Some(Ts,T,m)
⟶ Ts' = Ts ∧ P ⊢ T ≤ T'" by blast
qed
lemma leq_method_subtypes:
assumes leq:"P ⊢ D ≼⇧* C" and least:"P ⊢ D has least M = (Ts',T',m') via Ds"
and wf:"wf_prog wf_md P"
shows "∀Ts T m Cs. P ⊢ C has M = (Ts,T,m) via Cs ⟶
Ts = Ts' ∧ P ⊢ T' ≤ T"
using assms
proof (induct rule:rtrancl.induct)
fix C
assume Cleast:"P ⊢ C has least M = (Ts',T',m') via Ds"
{ fix Ts T m Cs
assume Chas:"P ⊢ C has M = (Ts,T,m) via Cs"
with Cleast have path:"P,C ⊢ Ds ⊑ Cs"
by (fastforce simp:LeastMethodDef_def HasMethodDef_def)
{ assume "Ds = Cs"
with Cleast Chas have "Ts = Ts' ∧ T' = T"
by (auto simp:LeastMethodDef_def HasMethodDef_def MethodDefs_def)
hence "Ts = Ts' ∧ P ⊢ T' ≤ T" by auto }
moreover
{ assume "(Ds,Cs) ∈ (leq_path1 P C)⇧+"
hence subcls:"(last Ds,last Cs) ∈ (subcls1 P)⇧+" using wf
by -(rule last_leq_paths)
from Chas obtain Bs fs ms where "class P (last Cs) = Some(Bs,fs,ms)"
and "map_of ms M = Some(Ts,T,m)"
by (auto simp:HasMethodDef_def MethodDefs_def)
hence ex:"∀Bs' fs' ms' Ts' T' m'. class P (last Ds) = Some(Bs',fs',ms') ∧
map_of ms' M = Some(Ts',T',m') ⟶ Ts = Ts' ∧ P ⊢ T' ≤ T"
using subcls wf
by -(rule subclsPlus_subtype,auto)
from Cleast obtain Bs' fs' ms' where "class P (last Ds) = Some(Bs',fs',ms')"
and "map_of ms' M = Some(Ts',T',m')"
by (auto simp:LeastMethodDef_def MethodDefs_def)
with ex have "Ts = Ts'" and "P ⊢ T' ≤ T" by auto }
ultimately have "Ts = Ts'" and "P ⊢ T' ≤ T" using path
by (auto dest!:rtranclD) }
thus "∀Ts T m Cs. P ⊢ C has M = (Ts, T, m) via Cs ⟶
Ts = Ts' ∧ P ⊢ T' ≤ T"
by (simp add:HasMethodDef_def MethodDefs_def)
next
fix D C' C
assume DleqC':"P ⊢ D ≼⇧* C'" and C'leqC:"P ⊢ C' ≺⇧1 C"
and Dleast:"P ⊢ D has least M = (Ts',T',m') via Ds"
and IH:"⟦P ⊢ D has least M = (Ts',T',m') via Ds; wf_prog wf_md P⟧
⟹ ∀Ts T m Cs. P ⊢ C' has M = (Ts, T, m) via Cs ⟶
Ts = Ts' ∧ P ⊢ T' ≤ T"
{ fix Ts T m Cs
assume Chas:"P ⊢ C has M = (Ts,T,m) via Cs"
from Dleast have classD:"is_class P D"
by (auto intro:Subobjs_isClass simp:LeastMethodDef_def MethodDefs_def)
from DleqC' C'leqC have "P ⊢ D ≼⇧* C" by simp
then obtain Cs' where "P ⊢ Path D to C via Cs'" using classD wf
by (auto dest:leq_implies_path)
hence Dhas:"P ⊢ D has M = (Ts,T,m) via Cs'@⇩pCs" using Chas wf
by (fastforce intro:has_path_has)
with Dleast have path:"P,D ⊢ Ds ⊑ Cs'@⇩pCs"
by (auto simp:LeastMethodDef_def HasMethodDef_def)
{ assume "Ds = Cs'@⇩pCs"
with Dleast Dhas have "Ts = Ts' ∧ T' = T"
by (auto simp:LeastMethodDef_def HasMethodDef_def MethodDefs_def)
hence "Ts = Ts' ∧ T' = T" by auto }
moreover
{ assume "(Ds,Cs'@⇩pCs) ∈ (leq_path1 P D)⇧+"
hence subcls:"(last Ds,last (Cs'@⇩pCs)) ∈ (subcls1 P)⇧+" using wf
by -(rule last_leq_paths)
from Dhas obtain Bs fs ms where "class P (last (Cs'@⇩pCs)) = Some(Bs,fs,ms)"
and "map_of ms M = Some(Ts,T,m)"
by (auto simp:HasMethodDef_def MethodDefs_def)
hence ex:"∀Bs' fs' ms' Ts' T' m'. class P (last Ds) = Some(Bs',fs',ms') ∧
map_of ms' M = Some(Ts',T',m') ⟶
Ts = Ts' ∧ P ⊢ T' ≤ T"
using subcls wf
by -(rule subclsPlus_subtype,auto)
from Dleast obtain Bs' fs' ms' where "class P (last Ds) = Some(Bs',fs',ms')"
and "map_of ms' M = Some(Ts',T',m')"
by (auto simp:LeastMethodDef_def MethodDefs_def)
with ex have "Ts = Ts'" and "P ⊢ T' ≤ T" by auto }
ultimately have "Ts = Ts'" and "P ⊢ T' ≤ T" using path
by (auto dest!:rtranclD) }
thus "∀Ts T m Cs. P ⊢ C has M = (Ts, T, m) via Cs ⟶
Ts = Ts' ∧ P ⊢ T' ≤ T"
by simp
qed
lemma leq_methods_subtypes:
assumes leq:"P ⊢ D ≼⇧* C" and least:"(Ds,(Ts',T',m')) ∈ MinimalMethodDefs P D M"
and wf:"wf_prog wf_md P"
shows "∀Ts T m Cs Cs'. P ⊢ Path D to C via Cs' ∧ P,D ⊢ Ds ⊑ Cs'@⇩pCs ∧ Cs ≠ [] ∧
P ⊢ C has M = (Ts,T,m) via Cs
⟶ Ts = Ts' ∧ P ⊢ T' ≤ T"
using assms
proof (induct rule:rtrancl.induct)
fix C
assume Cleast:"(Ds,(Ts',T',m')) ∈ MinimalMethodDefs P C M"
{ fix Ts T m Cs Cs'
assume path':"P ⊢ Path C to C via Cs'"
and leq_path:"P,C ⊢ Ds ⊑ Cs' @⇩p Cs" and notempty:"Cs ≠ []"
and Chas:"P ⊢ C has M = (Ts,T,m) via Cs"
from path' wf have Cs':"Cs' = [C]" by(rule path_via_C)
from leq_path Cs' notempty have leq':"P,C ⊢ Ds ⊑ Cs"
by(auto simp:appendPath_def split:if_split_asm)
{ assume "Ds = Cs"
with Cleast Chas have "Ts = Ts' ∧ T' = T"
by (auto simp:MinimalMethodDefs_def HasMethodDef_def MethodDefs_def)
hence "Ts = Ts' ∧ P ⊢ T' ≤ T" by auto }
moreover
{ assume "(Ds,Cs) ∈ (leq_path1 P C)⇧+"
hence subcls:"(last Ds,last Cs) ∈ (subcls1 P)⇧+" using wf
by -(rule last_leq_paths)
from Chas obtain Bs fs ms where "class P (last Cs) = Some(Bs,fs,ms)"
and "map_of ms M = Some(Ts,T,m)"
by (auto simp:HasMethodDef_def MethodDefs_def)
hence ex:"∀Bs' fs' ms' Ts' T' m'. class P (last Ds) = Some(Bs',fs',ms') ∧
map_of ms' M = Some(Ts',T',m') ⟶ Ts = Ts' ∧ P ⊢ T' ≤ T"
using subcls wf
by -(rule subclsPlus_subtype,auto)
from Cleast obtain Bs' fs' ms' where "class P (last Ds) = Some(Bs',fs',ms')"
and "map_of ms' M = Some(Ts',T',m')"
by (auto simp:MinimalMethodDefs_def MethodDefs_def)
with ex have "Ts = Ts'" and "P ⊢ T' ≤ T" by auto }
ultimately have "Ts = Ts'" and "P ⊢ T' ≤ T" using leq'
by (auto dest!:rtranclD) }
thus "∀Ts T m Cs Cs'. P ⊢ Path C to C via Cs' ∧ P,C ⊢ Ds ⊑ Cs' @⇩p Cs ∧ Cs ≠ [] ∧
P ⊢ C has M = (Ts, T, m) via Cs ⟶
Ts = Ts' ∧ P ⊢ T' ≤ T" by blast
next
fix D C' C
assume DleqC':"P ⊢ D ≼⇧* C'" and C'leqC:"P ⊢ C' ≺⇧1 C"
and Dleast:"(Ds, Ts', T', m') ∈ MinimalMethodDefs P D M"
and IH:"⟦(Ds,Ts',T',m') ∈ MinimalMethodDefs P D M; wf_prog wf_md P⟧
⟹ ∀Ts T m Cs Cs'. P ⊢ Path D to C' via Cs' ∧
P,D ⊢ Ds ⊑ Cs' @⇩p Cs ∧ Cs ≠ [] ∧ P ⊢ C' has M = (Ts, T, m) via Cs ⟶
Ts = Ts' ∧ P ⊢ T' ≤ T"
{ fix Ts T m Cs Cs'
assume path:"P ⊢ Path D to C via Cs'"
and leq_path:"P,D ⊢ Ds ⊑ Cs' @⇩p Cs"
and notempty:"Cs ≠ []"
and Chas:"P ⊢ C has M = (Ts,T,m) via Cs"
from Dleast have classD:"is_class P D"
by (auto intro:Subobjs_isClass simp:MinimalMethodDefs_def MethodDefs_def)
from path have Dhas:"P ⊢ D has M = (Ts,T,m) via Cs'@⇩pCs" using Chas wf
by (fastforce intro:has_path_has)
{ assume "Ds = Cs'@⇩pCs"
with Dleast Dhas have "Ts = Ts' ∧ T' = T"
by (auto simp:MinimalMethodDefs_def HasMethodDef_def MethodDefs_def)
hence "Ts = Ts' ∧ T' = T" by auto }
moreover
{ assume "(Ds,Cs'@⇩pCs) ∈ (leq_path1 P D)⇧+"
hence subcls:"(last Ds,last (Cs'@⇩pCs)) ∈ (subcls1 P)⇧+" using wf
by -(rule last_leq_paths)
from Dhas obtain Bs fs ms where "class P (last (Cs'@⇩pCs)) = Some(Bs,fs,ms)"
and "map_of ms M = Some(Ts,T,m)"
by (auto simp:HasMethodDef_def MethodDefs_def)
hence ex:"∀Bs' fs' ms' Ts' T' m'. class P (last Ds) = Some(Bs',fs',ms') ∧
map_of ms' M = Some(Ts',T',m') ⟶
Ts = Ts' ∧ P ⊢ T' ≤ T"
using subcls wf
by -(rule subclsPlus_subtype,auto)
from Dleast obtain Bs' fs' ms' where "class P (last Ds) = Some(Bs',fs',ms')"
and "map_of ms' M = Some(Ts',T',m')"
by (auto simp:MinimalMethodDefs_def MethodDefs_def)
with ex have "Ts = Ts'" and "P ⊢ T' ≤ T" by auto }
ultimately have "Ts = Ts'" and "P ⊢ T' ≤ T" using leq_path
by (auto dest!:rtranclD) }
thus "∀Ts T m Cs Cs'. P ⊢ Path D to C via Cs' ∧ P,D ⊢ Ds ⊑ Cs' @⇩p Cs ∧ Cs ≠ [] ∧
P ⊢ C has M = (Ts, T, m) via Cs ⟶
Ts = Ts' ∧ P ⊢ T' ≤ T"
by blast
qed
lemma select_least_methods_subtypes:
assumes select_method:"P ⊢ (C,Cs@⇩pDs) selects M = (Ts,T,pns,body) via Cs'"
and least_method:"P ⊢ last Cs has least M = (Ts',T',pns',body') via Ds"
and path:"P ⊢ Path C to (last Cs) via Cs"
and wf:"wf_prog wf_md P"
shows "Ts' = Ts ∧ P ⊢ T ≤ T'"
using select_method
proof -
from path have sub:"P ⊢ C ≼⇧* last Cs"
by(fastforce intro:Subobjs_subclass simp:path_via_def)
from least_method have has:"P ⊢ last Cs has M = (Ts',T',pns',body') via Ds"
by(rule has_least_method_has_method)
from select_method show ?thesis
proof cases
case dyn_unique
hence dyn:"P ⊢ C has least M = (Ts,T,pns,body) via Cs'" by simp
with sub has wf show ?thesis
by -(drule leq_method_subtypes,assumption,simp,blast)+
next
case dyn_ambiguous
hence overrider:"P ⊢ (C,Cs@⇩pDs) has overrider M = (Ts,T,pns,body) via Cs'"
by simp
from least_method have notempty:"Ds ≠ []"
by(auto intro!:Subobjs_nonempty simp:LeastMethodDef_def MethodDefs_def)
have "last Cs = hd Ds ⟹ last (Cs @ tl Ds) = last Ds"
proof(cases "tl Ds = []")
case True
assume last:"last Cs = hd Ds"
with True notempty have "Ds = [last Cs]" by (fastforce dest:hd_Cons_tl)
hence "last Ds = last Cs" by simp
with True show ?thesis by simp
next
case False
assume last:"last Cs = hd Ds"
from notempty False have "last (tl Ds) = last Ds"
by -(drule hd_Cons_tl,drule_tac x="hd Ds" in last_ConsR,simp)
with False show ?thesis by simp
qed
hence eq:"(Cs @⇩p Ds) @⇩p [last Ds] = (Cs @⇩p Ds)"
by(simp add:appendPath_def)
from least_method wf
have "P ⊢ last Ds has least M = (Ts',T',pns',body') via [last Ds]"
by(auto dest:Subobj_last_isClass intro:Subobjs_Base subobjs_rel
simp:LeastMethodDef_def MethodDefs_def)
with notempty
have "P ⊢ last (Cs@⇩pDs) has least M = (Ts',T',pns',body') via [last Ds]"
by -(drule_tac Cs'="Cs" in appendPath_last,simp)
with overrider wf eq have "(Cs',Ts,T,pns,body) ∈ MinimalMethodDefs P C M"
and "P,C ⊢ Cs' ⊑ Cs @⇩p Ds"
by -(auto simp:FinalOverriderMethodDef_def OverriderMethodDefs_def,
drule wf_sees_method_fun,auto)
with sub wf path notempty has show ?thesis
by -(drule leq_methods_subtypes,simp_all,blast)+
qed
qed
lemma wf_syscls:
"set SystemClasses ⊆ set P ⟹ wf_syscls P"
by (simp add: image_def SystemClasses_def wf_syscls_def sys_xcpts_def
NullPointerC_def ClassCastC_def OutOfMemoryC_def,force intro:conjI)
subsection‹Well formedness and widen›
lemma Class_widen: "⟦P ⊢ Class C ≤ T; wf_prog wf_md P; is_class P C⟧
⟹ ∃D. T = Class D ∧ P ⊢ Path C to D unique"
apply (ind_cases "P ⊢ Class C ≤ T")
apply (auto intro:path_C_to_C_unique)
done
lemma Class_widen_Class [iff]: "⟦wf_prog wf_md P; is_class P C⟧ ⟹
(P ⊢ Class C ≤ Class D) = (P ⊢ Path C to D unique)"
apply (rule iffI)
apply (ind_cases " P ⊢ Class C ≤ Class D")
apply (auto elim: widen_subcls intro:path_C_to_C_unique)
done
lemma widen_Class: "⟦wf_prog wf_md P; is_class P C⟧ ⟹
(P ⊢ T ≤ Class C) =
(T = NT ∨ (∃D. T = Class D ∧ P ⊢ Path D to C unique))"
apply(induct T) apply (auto intro:widen_subcls)
apply (ind_cases "P ⊢ Class D ≤ Class C" for D) apply (auto intro:path_C_to_C_unique)
done
subsection‹Well formedness and well typing›
lemma assumes wf:"wf_prog wf_md P"
shows WT_determ: "P,E ⊢ e :: T ⟹ (⋀T'. P,E ⊢ e :: T' ⟹ T = T')"
and WTs_determ: "P,E ⊢ es [::] Ts ⟹ (⋀Ts'. P,E ⊢ es [::] Ts' ⟹ Ts = Ts')"
proof(induct rule:WT_WTs_inducts)
case (WTDynCast E e D C)
have "P,E ⊢ Cast C e :: T'" by fact
thus ?case by (fastforce elim:WT.cases)
next
case (WTStaticCast E e D C)
have "P,E ⊢ ⦇C⦈e :: T'" by fact
thus ?case by (fastforce elim:WT.cases)
next
case (WTBinOp E e⇩1 T⇩1 e⇩2 T⇩2 bop T)
have bop:"case bop of Eq ⇒ T⇩1 = T⇩2 ∧ T = Boolean
| Add ⇒ T⇩1 = Integer ∧ T⇩2 = Integer ∧ T = Integer"
and wt:"P,E ⊢ e⇩1 «bop» e⇩2 :: T'" by fact+
from wt obtain T1' T2' where
bop':"case bop of Eq ⇒ T1' = T2' ∧ T' = Boolean
| Add ⇒ T1' = Integer ∧ T2' = Integer ∧ T' = Integer"
by auto
from bop show ?case
proof (cases bop)
assume Eq:"bop = Eq"
with bop have "T = Boolean" by auto
with Eq bop' show ?thesis by simp
next
assume Add:"bop = Add"
with bop have "T = Integer"
by auto
with Add bop' show ?thesis by simp
qed
next
case (WTLAss E V T e T' T'')
have "P,E ⊢ V:=e :: T''"
and "E V = Some T" by fact+
thus ?case by auto
next
case (WTFAcc E e C F T Cs)
have IH:"⋀T'. P,E ⊢ e :: T' ⟹ Class C = T'"
and least:"P ⊢ C has least F:T via Cs"
and wt:"P,E ⊢ e∙F{Cs} :: T'" by fact+
from wt obtain C' where wte':"P,E ⊢ e :: Class C'"
and least':"P ⊢ C' has least F:T' via Cs" by auto
from IH[OF wte'] have "C = C'" by simp
with least least' show ?case
by (fastforce simp:sees_field_fun)
next
case (WTFAss E e⇩1 C F T Cs e⇩2 T' T'')
have least:"P ⊢ C has least F:T via Cs"
and wt:"P,E ⊢ e⇩1∙F{Cs} := e⇩2 :: T''"
and IH:"⋀S. P,E ⊢ e⇩1 :: S ⟹ Class C = S" by fact+
from wt obtain C' where wte':"P,E ⊢ e⇩1 :: Class C'"
and least':"P ⊢ C' has least F:T'' via Cs" by auto
from IH[OF wte'] have "C = C'" by simp
with least least' show ?case
by (fastforce simp:sees_field_fun)
next
case (WTCall E e C M Ts T pns body Cs es Ts')
have IH:"⋀T'. P,E ⊢ e :: T' ⟹ Class C = T'"
and least:"P ⊢ C has least M = (Ts, T, pns, body) via Cs"
and wt:"P,E ⊢ e∙M(es) :: T'" by fact+
from wt obtain C' Ts' pns' body' Cs' where wte':"P,E ⊢ e :: Class C'"
and least':"P ⊢ C' has least M = (Ts',T',pns',body') via Cs'" by auto
from IH[OF wte'] have "C = C'" by simp
with least least' wf show ?case by (auto dest:wf_sees_method_fun)
next
case (WTStaticCall E e C' C M Ts T pns body Cs es Ts')
have IH:"⋀T'. P,E ⊢ e :: T' ⟹ Class C' = T'"
and unique:"P ⊢ Path C' to C unique"
and least:"P ⊢ C has least M = (Ts, T, pns, body) via Cs"
and wt:"P,E ⊢ e∙(C::)M(es) :: T'" by fact+
from wt obtain Ts' pns' body' Cs'
where "P ⊢ C has least M = (Ts',T',pns',body') via Cs'" by auto
with least wf show ?case by (auto dest:wf_sees_method_fun)
next
case WTBlock thus ?case by (clarsimp simp del:fun_upd_apply)
next
case (WTSeq E e⇩1 T⇩1 e⇩2 T⇩2)
have IH:"⋀T'. P,E ⊢ e⇩2 :: T' ⟹ T⇩2 = T'"
and wt:"P,E ⊢ e⇩1;; e⇩2 :: T'" by fact+
from wt have wt':"P,E ⊢ e⇩2 :: T'" by auto
from IH[OF wt'] show ?case .
next
case (WTCond E e e⇩1 T e⇩2)
have IH:"⋀S. P,E ⊢ e⇩1 :: S ⟹ T = S"
and wt:"P,E ⊢ if (e) e⇩1 else e⇩2 :: T'" by fact+
from wt have "P,E ⊢ e⇩1 :: T'" by auto
from IH[OF this] show ?case .
next
case (WTCons E e T es Ts)
have IHe:"⋀T'. P,E ⊢ e :: T' ⟹ T = T'"
and IHes:"⋀Ts'. P,E ⊢ es [::] Ts' ⟹ Ts = Ts'"
and wt:"P,E ⊢ e # es [::] Ts'" by fact+
from wt show ?case
proof (cases Ts')
case Nil with wt show ?thesis by simp
next
case (Cons T'' Ts'')
with wt have wte':"P,E ⊢ e :: T''" and wtes':"P,E ⊢ es [::] Ts''"
by auto
from IHe[OF wte'] IHes[OF wtes'] Cons show ?thesis by simp
qed
qed clarsimp+
end
Theory Equivalence
section ‹Equivalence of Big Step and Small Step Semantics›
theory Equivalence imports BigStep SmallStep WWellForm begin
subsection‹Some casts-lemmas›
lemma assumes wf:"wf_prog wf_md P"
shows casts_casts:
"P ⊢ T casts v to v' ⟹ P ⊢ T casts v' to v'"
proof(induct rule:casts_to.induct)
case casts_prim thus ?case by(rule casts_to.casts_prim)
next
case (casts_null C) thus ?case by(rule casts_to.casts_null)
next
case (casts_ref Cs C Cs' Ds a)
have path_via:"P ⊢ Path last Cs to C via Cs'" and Ds:"Ds = Cs @⇩p Cs'" by fact+
with wf have "last Cs' = C" and "Cs' ≠ []" and "class": "is_class P C"
by(auto intro!:Subobjs_nonempty Subobj_last_isClass simp:path_via_def)
with Ds have last:"last Ds = C"
by -(drule_tac Cs' = "Cs" in appendPath_last,simp)
hence Ds':"Ds = Ds @⇩p [C]" by(simp add:appendPath_def)
from last "class" have "P ⊢ Path last Ds to C via [C]"
by(fastforce intro:Subobjs_Base simp:path_via_def)
with Ds' show ?case by(fastforce intro:casts_to.casts_ref)
qed
lemma casts_casts_eq:
"⟦ P ⊢ T casts v to v; P ⊢ T casts v to v'; wf_prog wf_md P ⟧ ⟹ v = v'"
apply -
apply(erule casts_to.cases)
apply clarsimp
apply(erule casts_to.cases)
apply simp
apply simp
apply (simp (asm_lr))
apply(erule casts_to.cases)
apply simp
apply simp
apply simp
apply simp
apply(erule casts_to.cases)
apply simp
apply simp
apply clarsimp
apply(erule appendPath_path_via)
by auto
lemma assumes wf:"wf_prog wf_md P"
shows None_lcl_casts_values:
"P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',(h',l')⟩ ⟹
(⋀V. ⟦l V = None; E V = Some T; l' V = Some v'⟧
⟹ P ⊢ T casts v' to v')"
and "P,E ⊢ ⟨es,(h,l)⟩ [→] ⟨es',(h',l')⟩ ⟹
(⋀V. ⟦l V = None; E V = Some T; l' V = Some v'⟧
⟹ P ⊢ T casts v' to v')"
proof(induct rule:red_reds_inducts)
case (RedLAss E V T' w w' h l V')
have env:"E V = Some T'" and env':"E V' = Some T"
and l:"l V' = None" and lupd:"(l(V ↦ w')) V' = Some v'"
and casts:"P ⊢ T' casts w to w'" by fact+
show ?case
proof(cases "V = V'")
case True
with lupd have v':"v' = w'" by simp
from True env env' have "T = T'" by simp
with v' casts wf show ?thesis by(fastforce intro:casts_casts)
next
case False
with lupd have "l V' = Some v'" by(fastforce split:if_split_asm)
with l show ?thesis by simp
qed
next
case (BlockRedNone E V T' e h l e' h' l' V')
have l:"l V' = None"
and l'upd:"(l'(V := l V)) V' = Some v'" and env:"E V' = Some T"
and IH:"⋀V'. ⟦(l(V := None)) V' = None; (E(V ↦ T')) V' = Some T;
l' V' = Some v'⟧
⟹ P ⊢ T casts v' to v'" by fact+
show ?case
proof(cases "V = V'")
case True
with l'upd l show ?thesis by fastforce
next
case False
with l l'upd have lnew:"(l(V := None)) V' = None"
and l'new:"l' V' = Some v'" by (auto split:if_split_asm)
from env False have env':"(E(V ↦ T')) V' = Some T" by fastforce
from IH[OF lnew env' l'new] show ?thesis .
qed
next
case (BlockRedSome E V T' e h l e' h' l' v V')
have l:"l V' = None"
and l'upd:"(l'(V := l V)) V' = Some v'" and env:"E V' = Some T"
and IH:"⋀V'. ⟦(l(V := None)) V' = None; (E(V ↦ T')) V' = Some T;
l' V' = Some v'⟧
⟹ P ⊢ T casts v' to v'" by fact+
show ?case
proof(cases "V = V'")
case True
with l l'upd show ?thesis by fastforce
next
case False
with l l'upd have lnew:"(l(V := None)) V' = None"
and l'new:"l' V' = Some v'" by (auto split:if_split_asm)
from env False have env':"(E(V ↦ T')) V' = Some T" by fastforce
from IH[OF lnew env' l'new] show ?thesis .
qed
next
case (InitBlockRed E V T' e h l w' e' h' l' w'' w V')
have l:"l V' = None"
and l'upd:"(l'(V := l V)) V' = Some v'" and env:"E V' = Some T"
and IH:"⋀V'. ⟦(l(V ↦ w')) V' = None; (E(V ↦ T')) V' = Some T;
l' V' = Some v'⟧
⟹ P ⊢ T casts v' to v'" by fact+
show ?case
proof(cases "V = V'")
case True
with l l'upd show ?thesis by fastforce
next
case False
with l l'upd have lnew:"(l(V ↦ w')) V' = None"
and l'new:"l' V' = Some v'" by (auto split:if_split_asm)
from env False have env':"(E(V ↦ T')) V' = Some T" by fastforce
from IH[OF lnew env' l'new] show ?thesis .
qed
qed (auto intro:casts_casts wf)
lemma assumes wf:"wf_prog wf_md P"
shows Some_lcl_casts_values:
"P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',(h',l')⟩ ⟹
(⋀V. ⟦l V = Some v; E V = Some T;
P ⊢ T casts v'' to v; l' V = Some v'⟧
⟹ P ⊢ T casts v' to v')"
and "P,E ⊢ ⟨es,(h,l)⟩ [→] ⟨es',(h',l')⟩ ⟹
(⋀V. ⟦l V = Some v; E V = Some T;
P ⊢ T casts v'' to v; l' V = Some v'⟧
⟹ P ⊢ T casts v' to v')"
proof(induct rule:red_reds_inducts)
case (RedNew h a h' C' E l V)
have l1:"l V = Some v" and l2:"l V = Some v'"
and casts:"P ⊢ T casts v'' to v " by fact+
from l1 l2 have eq:"v = v'" by simp
with casts wf show ?case by(fastforce intro:casts_casts)
next
case (RedLAss E V T' w w' h l V')
have l:"l V' = Some v" and lupd:"(l(V ↦ w')) V' = Some v'"
and T'casts:"P ⊢ T' casts w to w'"
and env:"E V = Some T'" and env':"E V' = Some T"
and casts:"P ⊢ T casts v'' to v" by fact+
show ?case
proof (cases "V = V'")
case True
with lupd have v':"v' = w'" by simp
from True env env' have "T = T'" by simp
with T'casts v' wf show ?thesis by(fastforce intro:casts_casts)
next
case False
with l lupd have "v = v'" by (auto split:if_split_asm)
with casts wf show ?thesis by(fastforce intro:casts_casts)
qed
next
case (RedFAss h a D S Cs' F T' Cs w w' Ds fs E l V)
have l1:"l V = Some v" and l2:"l V = Some v'"
and hp:"h a = Some(D, S)"
and T'casts:"P ⊢ T' casts w to w'"
and casts:"P ⊢ T casts v'' to v" by fact+
from l1 l2 have eq:"v = v'" by simp
with casts wf show ?case by(fastforce intro:casts_casts)
next
case (BlockRedNone E V T' e h l e' h' l' V')
have l':"l' V = None" and l:"l V' = Some v"
and l'upd:"(l'(V := l V)) V' = Some v'" and env:"E V' = Some T"
and casts:"P ⊢ T casts v'' to v"
and IH:"⋀V'. ⟦(l(V := None)) V' = Some v; (E(V ↦ T')) V' = Some T;
P ⊢ T casts v'' to v ; l' V' = Some v'⟧
⟹ P ⊢ T casts v' to v'" by fact+
show ?case
proof(cases "V = V'")
case True
with l' l'upd have "l V = Some v'" by auto
with True l have eq:"v = v'" by simp
with casts wf show ?thesis by(fastforce intro:casts_casts)
next
case False
with l l'upd have lnew:"(l(V := None)) V' = Some v"
and l'new:"l' V' = Some v'" by (auto split:if_split_asm)
from env False have env':"(E(V ↦ T')) V' = Some T" by fastforce
from IH[OF lnew env' casts l'new] show ?thesis .
qed
next
case (BlockRedSome E V T' e h l e' h' l' w V')
have l':"l' V = Some w" and l:"l V' = Some v"
and l'upd:"(l'(V := l V)) V' = Some v'" and env:"E V' = Some T"
and casts:"P ⊢ T casts v'' to v"
and IH:"⋀V'. ⟦(l(V := None)) V' = Some v; (E(V ↦ T')) V' = Some T;
P ⊢ T casts v'' to v ; l' V' = Some v'⟧
⟹ P ⊢ T casts v' to v'" by fact+
show ?case
proof(cases "V = V'")
case True
with l' l'upd have "l V = Some v'" by auto
with True l have eq:"v = v'" by simp
with casts wf show ?thesis by(fastforce intro:casts_casts)
next
case False
with l l'upd have lnew:"(l(V := None)) V' = Some v"
and l'new:"l' V' = Some v'" by (auto split:if_split_asm)
from env False have env':"(E(V ↦ T')) V' = Some T" by fastforce
from IH[OF lnew env' casts l'new] show ?thesis .
qed
next
case (InitBlockRed E V T' e h l w' e' h' l' w'' w V')
have l:"l V' = Some v" and l':"l' V = Some w''"
and l'upd:"(l'(V := l V)) V' = Some v'" and env:"E V' = Some T"
and casts:"P ⊢ T casts v'' to v"
and IH:"⋀V'. ⟦(l(V ↦ w')) V' = Some v; (E(V ↦ T')) V' = Some T;
P ⊢ T casts v'' to v ; l' V' = Some v'⟧
⟹ P ⊢ T casts v' to v'" by fact+
show ?case
proof(cases "V = V'")
case True
with l' l'upd have "l V = Some v'" by auto
with True l have eq:"v = v'" by simp
with casts wf show ?thesis by(fastforce intro:casts_casts)
next
case False
with l l'upd have lnew:"(l(V ↦ w')) V' = Some v"
and l'new:"l' V' = Some v'" by (auto split:if_split_asm)
from env False have env':"(E(V ↦ T')) V' = Some T" by fastforce
from IH[OF lnew env' casts l'new] show ?thesis .
qed
qed (auto intro:casts_casts wf)
subsection‹Small steps simulate big step›
subsection ‹Cast›
lemma StaticCastReds:
"P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ⟹ P,E ⊢ ⟨⦇C⦈e,s⟩ →* ⟨⦇C⦈e',s'⟩"
apply(erule rtrancl_induct2)
apply blast
apply(erule rtrancl_into_rtrancl)
apply (simp add:StaticCastRed)
done
lemma StaticCastRedsNull:
"P,E ⊢ ⟨e,s⟩ →* ⟨null,s'⟩ ⟹ P,E ⊢ ⟨⦇C⦈e,s⟩ →* ⟨null,s'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule StaticCastReds)
apply(simp add:RedStaticCastNull)
done
lemma StaticUpCastReds:
"⟦ P,E ⊢ ⟨e,s⟩ →* ⟨ref(a,Cs),s'⟩; P ⊢ Path last Cs to C via Cs'; Ds = Cs@⇩pCs' ⟧
⟹ P,E ⊢ ⟨⦇C⦈e,s⟩ →* ⟨ref(a,Ds),s'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule StaticCastReds)
apply(fastforce intro:RedStaticUpCast)
done
lemma StaticDownCastReds:
"P,E ⊢ ⟨e,s⟩ →* ⟨ref(a,Cs@[C]@Cs'),s'⟩
⟹ P,E ⊢ ⟨⦇C⦈e,s⟩ →* ⟨ref(a,Cs@[C]),s'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule StaticCastReds)
apply simp
apply(subgoal_tac "P,E ⊢ ⟨⦇C⦈ref(a,Cs@[C]@Cs'),s'⟩ → ⟨ref(a,Cs@[C]),s'⟩")
apply simp
apply(rule RedStaticDownCast)
done
lemma StaticCastRedsFail:
"⟦ P,E ⊢ ⟨e,s⟩ →* ⟨ref(a,Cs),s'⟩; C ∉ set Cs; ¬ P ⊢ (last Cs) ≼⇧* C ⟧
⟹ P,E ⊢ ⟨⦇C⦈e,s⟩ →* ⟨THROW ClassCast,s'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule StaticCastReds)
apply(fastforce intro:RedStaticCastFail)
done
lemma StaticCastRedsThrow:
"⟦ P,E ⊢ ⟨e,s⟩ →* ⟨Throw r,s'⟩ ⟧ ⟹ P,E ⊢ ⟨⦇C⦈e,s⟩ →* ⟨Throw r,s'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule StaticCastReds)
apply(simp add:red_reds.StaticCastThrow)
done
lemma DynCastReds:
"P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ⟹ P,E ⊢ ⟨Cast C e,s⟩ →* ⟨Cast C e',s'⟩"
apply(erule rtrancl_induct2)
apply blast
apply(erule rtrancl_into_rtrancl)
apply (simp add:DynCastRed)
done
lemma DynCastRedsNull:
"P,E ⊢ ⟨e,s⟩ →* ⟨null,s'⟩ ⟹ P,E ⊢ ⟨Cast C e,s⟩ →* ⟨null,s'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule DynCastReds)
apply(simp add:RedDynCastNull)
done
lemma DynCastRedsRef:
"⟦ P,E ⊢ ⟨e,s⟩ →* ⟨ref(a,Cs),s'⟩; hp s' a = Some (D,S); P ⊢ Path D to C via Cs';
P ⊢ Path D to C unique ⟧
⟹ P,E ⊢ ⟨Cast C e,s⟩ →* ⟨ref(a,Cs'),s'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule DynCastReds)
apply(fastforce intro:RedDynCast)
done
lemma StaticUpDynCastReds:
"⟦ P,E ⊢ ⟨e,s⟩ →* ⟨ref(a,Cs),s'⟩; P ⊢ Path last Cs to C unique;
P ⊢ Path last Cs to C via Cs'; Ds = Cs@⇩pCs' ⟧
⟹ P,E ⊢ ⟨Cast C e,s⟩ →* ⟨ref(a,Ds),s'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule DynCastReds)
apply(fastforce intro:RedStaticUpDynCast)
done
lemma StaticDownDynCastReds:
"P,E ⊢ ⟨e,s⟩ →* ⟨ref(a,Cs@[C]@Cs'),s'⟩
⟹ P,E ⊢ ⟨Cast C e,s⟩ →* ⟨ref(a,Cs@[C]),s'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule DynCastReds)
apply simp
apply(subgoal_tac "P,E ⊢ ⟨Cast C (ref(a,Cs@[C]@Cs')),s'⟩ → ⟨ref(a,Cs@[C]),s'⟩")
apply simp
apply(rule RedStaticDownDynCast)
done
lemma DynCastRedsFail:
"⟦ P,E ⊢ ⟨e,s⟩ →* ⟨ref(a,Cs),s'⟩; hp s' a = Some (D,S); ¬ P ⊢ Path D to C unique;
¬ P ⊢ Path last Cs to C unique; C ∉ set Cs ⟧
⟹ P,E ⊢ ⟨Cast C e,s⟩ →* ⟨null,s'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule DynCastReds)
apply(fastforce intro:RedDynCastFail)
done
lemma DynCastRedsThrow:
"⟦ P,E ⊢ ⟨e,s⟩ →* ⟨Throw r,s'⟩ ⟧ ⟹ P,E ⊢ ⟨Cast C e,s⟩ →* ⟨Throw r,s'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule DynCastReds)
apply(simp add:red_reds.DynCastThrow)
done
subsection ‹LAss›
lemma LAssReds:
"P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ⟹ P,E ⊢ ⟨V:=e,s⟩ →* ⟨V:=e',s'⟩"
apply(erule rtrancl_induct2)
apply blast
apply(erule rtrancl_into_rtrancl)
apply(simp add:LAssRed)
done
lemma LAssRedsVal:
"⟦ P,E ⊢ ⟨e,s⟩ →* ⟨Val v,(h',l')⟩; E V = Some T; P ⊢ T casts v to v'⟧
⟹ P,E ⊢ ⟨ V:=e,s⟩ →* ⟨Val v',(h',l'(V↦v'))⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule LAssReds)
apply(simp add:RedLAss)
done
lemma LAssRedsThrow:
"⟦ P,E ⊢ ⟨e,s⟩ →* ⟨Throw r,s'⟩ ⟧ ⟹ P,E ⊢ ⟨ V:=e,s⟩ →* ⟨Throw r,s'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule LAssReds)
apply(simp add:red_reds.LAssThrow)
done
subsection ‹BinOp›
lemma BinOp1Reds:
"P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ⟹ P,E ⊢ ⟨ e «bop» e⇩2, s⟩ →* ⟨e' «bop» e⇩2, s'⟩"
apply(erule rtrancl_induct2)
apply blast
apply(erule rtrancl_into_rtrancl)
apply(simp add:BinOpRed1)
done
lemma BinOp2Reds:
"P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ⟹ P,E ⊢ ⟨(Val v) «bop» e, s⟩ →* ⟨(Val v) «bop» e', s'⟩"
apply(erule rtrancl_induct2)
apply blast
apply(erule rtrancl_into_rtrancl)
apply(simp add:BinOpRed2)
done
lemma BinOpRedsVal:
"⟦ P,E ⊢ ⟨e⇩1,s⇩0⟩ →* ⟨Val v⇩1,s⇩1⟩; P,E ⊢ ⟨e⇩2,s⇩1⟩ →* ⟨Val v⇩2,s⇩2⟩;
binop(bop,v⇩1,v⇩2) = Some v ⟧
⟹ P,E ⊢ ⟨e⇩1 «bop» e⇩2, s⇩0⟩ →* ⟨Val v,s⇩2⟩"
apply(rule rtrancl_trans)
apply(erule BinOp1Reds)
apply(rule rtrancl_into_rtrancl)
apply(erule BinOp2Reds)
apply(simp add:RedBinOp)
done
lemma BinOpRedsThrow1:
"P,E ⊢ ⟨e,s⟩ →* ⟨Throw r,s'⟩ ⟹ P,E ⊢ ⟨e «bop» e⇩2, s⟩ →* ⟨Throw r, s'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule BinOp1Reds)
apply(simp add:red_reds.BinOpThrow1)
done
lemma BinOpRedsThrow2:
"⟦ P,E ⊢ ⟨e⇩1,s⇩0⟩ →* ⟨Val v⇩1,s⇩1⟩; P,E ⊢ ⟨e⇩2,s⇩1⟩ →* ⟨Throw r,s⇩2⟩⟧
⟹ P,E ⊢ ⟨e⇩1 «bop» e⇩2, s⇩0⟩ →* ⟨Throw r,s⇩2⟩"
apply(rule rtrancl_trans)
apply(erule BinOp1Reds)
apply(rule rtrancl_into_rtrancl)
apply(erule BinOp2Reds)
apply(simp add:red_reds.BinOpThrow2)
done
subsection ‹FAcc›
lemma FAccReds:
"P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ⟹ P,E ⊢ ⟨e∙F{Cs}, s⟩ →* ⟨e'∙F{Cs}, s'⟩"
apply(erule rtrancl_induct2)
apply blast
apply(erule rtrancl_into_rtrancl)
apply(simp add:FAccRed)
done
lemma FAccRedsVal:
"⟦P,E ⊢ ⟨e,s⟩ →* ⟨ref(a,Cs'),s'⟩; hp s' a = Some(D,S);
Ds = Cs'@⇩pCs; (Ds,fs) ∈ S; fs F = Some v ⟧
⟹ P,E ⊢ ⟨e∙F{Cs},s⟩ →* ⟨Val v,s'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule FAccReds)
apply (fastforce intro:RedFAcc)
done
lemma FAccRedsNull:
"P,E ⊢ ⟨e,s⟩ →* ⟨null,s'⟩ ⟹ P,E ⊢ ⟨e∙F{Cs},s⟩ →* ⟨THROW NullPointer,s'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule FAccReds)
apply(simp add:RedFAccNull)
done
lemma FAccRedsThrow:
"P,E ⊢ ⟨e,s⟩ →* ⟨Throw r,s'⟩ ⟹ P,E ⊢ ⟨e∙F{Cs},s⟩ →* ⟨Throw r,s'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule FAccReds)
apply(simp add:red_reds.FAccThrow)
done
subsection ‹FAss›
lemma FAssReds1:
"P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ⟹ P,E ⊢ ⟨e∙F{Cs}:=e⇩2, s⟩ →* ⟨e'∙F{Cs}:=e⇩2, s'⟩"
apply(erule rtrancl_induct2)
apply blast
apply(erule rtrancl_into_rtrancl)
apply(simp add:FAssRed1)
done
lemma FAssReds2:
"P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ⟹ P,E ⊢ ⟨Val v∙F{Cs}:=e, s⟩ →* ⟨Val v∙F{Cs}:=e', s'⟩"
apply(erule rtrancl_induct2)
apply blast
apply(erule rtrancl_into_rtrancl)
apply(simp add:FAssRed2)
done
lemma FAssRedsVal:
"⟦ P,E ⊢ ⟨e⇩1,s⇩0⟩ →* ⟨ref(a,Cs'),s⇩1⟩; P,E ⊢ ⟨e⇩2,s⇩1⟩ →* ⟨Val v,(h⇩2,l⇩2)⟩;
h⇩2 a = Some(D,S); P ⊢ (last Cs') has least F:T via Cs; P ⊢ T casts v to v';
Ds = Cs'@⇩pCs; (Ds,fs) ∈ S ⟧ ⟹
P,E ⊢ ⟨e⇩1∙F{Cs}:=e⇩2, s⇩0⟩ →*
⟨Val v',(h⇩2(a↦(D,insert (Ds,fs(F↦v')) (S - {(Ds,fs)}))),l⇩2)⟩"
apply(rule rtrancl_trans)
apply(erule FAssReds1)
apply(rule rtrancl_into_rtrancl)
apply(erule FAssReds2)
apply(fastforce intro:RedFAss)
done
lemma FAssRedsNull:
"⟦ P,E ⊢ ⟨e⇩1,s⇩0⟩ →* ⟨null,s⇩1⟩; P,E ⊢ ⟨e⇩2,s⇩1⟩ →* ⟨Val v,s⇩2⟩ ⟧ ⟹
P,E ⊢ ⟨e⇩1∙F{Cs}:=e⇩2, s⇩0⟩ →* ⟨THROW NullPointer, s⇩2⟩"
apply(rule rtrancl_trans)
apply(erule FAssReds1)
apply(rule rtrancl_into_rtrancl)
apply(erule FAssReds2)
apply(simp add:RedFAssNull)
done
lemma FAssRedsThrow1:
"P,E ⊢ ⟨e,s⟩ →* ⟨Throw r,s'⟩ ⟹ P,E ⊢ ⟨e∙F{Cs}:=e⇩2, s⟩ →* ⟨Throw r, s'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule FAssReds1)
apply(simp add:red_reds.FAssThrow1)
done
lemma FAssRedsThrow2:
"⟦ P,E ⊢ ⟨e⇩1,s⇩0⟩ →* ⟨Val v,s⇩1⟩; P,E ⊢ ⟨e⇩2,s⇩1⟩ →* ⟨Throw r,s⇩2⟩ ⟧
⟹ P,E ⊢ ⟨e⇩1∙F{Cs}:=e⇩2,s⇩0⟩ →* ⟨Throw r,s⇩2⟩"
apply(rule rtrancl_trans)
apply(erule FAssReds1)
apply(rule rtrancl_into_rtrancl)
apply(erule FAssReds2)
apply(simp add:red_reds.FAssThrow2)
done
subsection ‹;;›
lemma SeqReds:
"P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ⟹ P,E ⊢ ⟨e;;e⇩2, s⟩ →* ⟨e';;e⇩2, s'⟩"
apply(erule rtrancl_induct2)
apply blast
apply(erule rtrancl_into_rtrancl)
apply(simp add:SeqRed)
done
lemma SeqRedsThrow:
"P,E ⊢ ⟨e,s⟩ →* ⟨Throw r,s'⟩ ⟹ P,E ⊢ ⟨e;;e⇩2, s⟩ →* ⟨Throw r, s'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule SeqReds)
apply(simp add:red_reds.SeqThrow)
done
lemma SeqReds2:
"⟦ P,E ⊢ ⟨e⇩1,s⇩0⟩ →* ⟨Val v⇩1,s⇩1⟩; P,E ⊢ ⟨e⇩2,s⇩1⟩ →* ⟨e⇩2',s⇩2⟩ ⟧ ⟹ P,E ⊢ ⟨e⇩1;;e⇩2, s⇩0⟩ →* ⟨e⇩2',s⇩2⟩"
apply(rule rtrancl_trans)
apply(erule SeqReds)
apply(rule_tac b="(e⇩2,s⇩1)" in converse_rtrancl_into_rtrancl)
apply(simp add:RedSeq)
apply assumption
done
subsection ‹If›
lemma CondReds:
"P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ⟹ P,E ⊢ ⟨if (e) e⇩1 else e⇩2,s⟩ →* ⟨if (e') e⇩1 else e⇩2,s'⟩"
apply(erule rtrancl_induct2)
apply blast
apply(erule rtrancl_into_rtrancl)
apply(simp add:CondRed)
done
lemma CondRedsThrow:
"P,E ⊢ ⟨e,s⟩ →* ⟨Throw r,s'⟩ ⟹ P,E ⊢ ⟨if (e) e⇩1 else e⇩2, s⟩ →* ⟨Throw r,s'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule CondReds)
apply(simp add:red_reds.CondThrow)
done
lemma CondReds2T:
"⟦P,E ⊢ ⟨e,s⇩0⟩ →* ⟨true,s⇩1⟩; P,E ⊢ ⟨e⇩1, s⇩1⟩ →* ⟨e',s⇩2⟩ ⟧ ⟹ P,E ⊢ ⟨if (e) e⇩1 else e⇩2, s⇩0⟩ →* ⟨e',s⇩2⟩"
apply(rule rtrancl_trans)
apply(erule CondReds)
apply(rule_tac b="(e⇩1, s⇩1)" in converse_rtrancl_into_rtrancl)
apply(simp add:RedCondT)
apply assumption
done
lemma CondReds2F:
"⟦P,E ⊢ ⟨e,s⇩0⟩ →* ⟨false,s⇩1⟩; P,E ⊢ ⟨e⇩2, s⇩1⟩ →* ⟨e',s⇩2⟩ ⟧ ⟹ P,E ⊢ ⟨if (e) e⇩1 else e⇩2, s⇩0⟩ →* ⟨e',s⇩2⟩"
apply(rule rtrancl_trans)
apply(erule CondReds)
apply(rule_tac b="(e⇩2, s⇩1)" in converse_rtrancl_into_rtrancl)
apply(simp add:RedCondF)
apply assumption
done
subsection ‹While›
lemma WhileFReds:
"P,E ⊢ ⟨b,s⟩ →* ⟨false,s'⟩ ⟹ P,E ⊢ ⟨while (b) c,s⟩ →* ⟨unit,s'⟩"
apply(rule_tac b="(if(b) (c;;while(b) c) else unit, s)" in converse_rtrancl_into_rtrancl)
apply(simp add:RedWhile)
apply(rule rtrancl_into_rtrancl)
apply(erule CondReds)
apply(simp add:RedCondF)
done
lemma WhileRedsThrow:
"P,E ⊢ ⟨b,s⟩ →* ⟨Throw r,s'⟩ ⟹ P,E ⊢ ⟨while (b) c,s⟩ →* ⟨Throw r,s'⟩"
apply(rule_tac b="(if(b) (c;;while(b) c) else unit, s)" in converse_rtrancl_into_rtrancl)
apply(simp add:RedWhile)
apply(rule rtrancl_into_rtrancl)
apply(erule CondReds)
apply(simp add:red_reds.CondThrow)
done
lemma WhileTReds:
"⟦ P,E ⊢ ⟨b,s⇩0⟩ →* ⟨true,s⇩1⟩; P,E ⊢ ⟨c,s⇩1⟩ →* ⟨Val v⇩1,s⇩2⟩; P,E ⊢ ⟨while (b) c,s⇩2⟩ →* ⟨e,s⇩3⟩ ⟧
⟹ P,E ⊢ ⟨while (b) c,s⇩0⟩ →* ⟨e,s⇩3⟩"
apply(rule_tac b="(if(b) (c;;while(b) c) else unit, s⇩0)" in converse_rtrancl_into_rtrancl)
apply(simp add:RedWhile)
apply(rule rtrancl_trans)
apply(erule CondReds)
apply(rule_tac b="(c;;while(b) c,s⇩1)" in converse_rtrancl_into_rtrancl)
apply(simp add:RedCondT)
apply(rule rtrancl_trans)
apply(erule SeqReds)
apply(rule_tac b="(while(b) c,s⇩2)" in converse_rtrancl_into_rtrancl)
apply(simp add:RedSeq)
apply assumption
done
lemma WhileTRedsThrow:
"⟦ P,E ⊢ ⟨b,s⇩0⟩ →* ⟨true,s⇩1⟩; P,E ⊢ ⟨c,s⇩1⟩ →* ⟨Throw r,s⇩2⟩ ⟧
⟹ P,E ⊢ ⟨while (b) c,s⇩0⟩ →* ⟨Throw r,s⇩2⟩"
apply(rule_tac b="(if(b) (c;;while(b) c) else unit, s⇩0)" in converse_rtrancl_into_rtrancl)
apply(simp add:RedWhile)
apply(rule rtrancl_trans)
apply(erule CondReds)
apply(rule_tac b="(c;;while(b) c,s⇩1)" in converse_rtrancl_into_rtrancl)
apply(simp add:RedCondT)
apply(rule rtrancl_trans)
apply(erule SeqReds)
apply(rule_tac b="(Throw r,s⇩2)" in converse_rtrancl_into_rtrancl)
apply(simp add:red_reds.SeqThrow)
apply simp
done
subsection ‹Throw›
lemma ThrowReds:
"P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ⟹ P,E ⊢ ⟨throw e,s⟩ →* ⟨throw e',s'⟩"
apply(erule rtrancl_induct2)
apply blast
apply(erule rtrancl_into_rtrancl)
apply(simp add:ThrowRed)
done
lemma ThrowRedsNull:
"P,E ⊢ ⟨e,s⟩ →* ⟨null,s'⟩ ⟹ P,E ⊢ ⟨throw e,s⟩ →* ⟨THROW NullPointer,s'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule ThrowReds)
apply(simp add:RedThrowNull)
done
lemma ThrowRedsThrow:
"P,E ⊢ ⟨e,s⟩ →* ⟨Throw r,s'⟩ ⟹ P,E ⊢ ⟨throw e,s⟩ →* ⟨Throw r,s'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule ThrowReds)
apply(simp add:red_reds.ThrowThrow)
done
subsection ‹InitBlock›
lemma assumes wf:"wf_prog wf_md P"
shows InitBlockReds_aux:
"P,E(V ↦ T) ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ⟹
∀h l h' l' v v'. s = (h,l(V↦v')) ⟶
P ⊢ T casts v to v' ⟶ s' = (h',l') ⟶
(∃v'' w. P,E ⊢ ⟨{V:T := Val v; e},(h,l)⟩ →*
⟨{V:T := Val v''; e'},(h',l'(V:=(l V)))⟩ ∧
P ⊢ T casts v'' to w)"
proof (erule converse_rtrancl_induct2)
{ fix h l h' l' v v'
assume "s' = (h, l(V ↦ v'))" and "s' = (h', l')"
hence h:"h = h'" and l':"l' = l(V ↦ v')" by simp_all
hence "P,E ⊢ ⟨{V:T; V:=Val v;; e'},(h, l)⟩ →*
⟨{V:T; V:=Val v;; e'},(h', l'(V := l V))⟩"
by(fastforce simp: fun_upd_same simp del:fun_upd_apply) }
hence "∀h l h' l' v v'.
s' = (h, l(V ↦ v')) ⟶
P ⊢ T casts v to v' ⟶
s' = (h', l') ⟶
P,E ⊢ ⟨{V:T; V:=Val v;; e'},(h, l)⟩ →*
⟨{V:T; V:=Val v;; e'},(h', l'(V := l V))⟩ ∧
P ⊢ T casts v to v'"
by auto
thus "∀h l h' l' v v'.
s' = (h, l(V ↦ v')) ⟶
P ⊢ T casts v to v' ⟶
s' = (h', l') ⟶
(∃v'' w. P,E ⊢ ⟨{V:T; V:=Val v;; e'},(h, l)⟩ →*
⟨{V:T; V:=Val v'';; e'},(h', l'(V := l V))⟩ ∧
P ⊢ T casts v'' to w)"
by auto
next
fix e s e'' s''
assume Red:"((e,s),e'',s'') ∈ Red P (E(V ↦ T))"
and reds:"P,E(V ↦ T) ⊢ ⟨e'',s''⟩ →* ⟨e',s'⟩"
and IH:"∀h l h' l' v v'.
s'' = (h, l(V ↦ v')) ⟶
P ⊢ T casts v to v' ⟶
s' = (h', l') ⟶
(∃v'' w. P,E ⊢ ⟨{V:T; V:=Val v;; e''},(h, l)⟩ →*
⟨{V:T; V:=Val v'';; e'},(h', l'(V := l V))⟩ ∧
P ⊢ T casts v'' to w)"
{ fix h l h' l' v v'
assume s:"s = (h, l(V ↦ v'))" and s':"s' = (h', l')"
and casts:"P ⊢ T casts v to v'"
obtain h'' l'' where s'':"s'' = (h'',l'')" by (cases s'') auto
with Red s have "V ∈ dom l''" by (fastforce dest:red_lcl_incr)
then obtain v'' where l'':"l'' V = Some v''" by auto
with Red s s'' casts
have step:"P,E ⊢ ⟨{V:T := Val v; e},(h, l)⟩ →
⟨{V:T := Val v''; e''}, (h'',l''(V := l V))⟩"
by(fastforce intro:InitBlockRed)
from Red s s'' l'' casts wf
have casts':"P ⊢ T casts v'' to v''" by(fastforce intro:Some_lcl_casts_values)
with IH s'' s' l'' obtain v''' w
where "P,E ⊢ ⟨{V:T := Val v''; e''}, (h'',l''(V := l V))⟩ →*
⟨{V:T := Val v'''; e'},(h', l'(V := l V))⟩ ∧
P ⊢ T casts v''' to w"
apply simp
apply (erule_tac x = "l''(V := l V)" in allE)
apply (erule_tac x = "v''" in allE)
apply (erule_tac x = "v''" in allE)
by(auto intro:ext)
with step have "∃v'' w. P,E ⊢ ⟨{V:T; V:=Val v;; e},(h, l)⟩ →*
⟨{V:T; V:=Val v'';; e'},(h', l'(V := l V))⟩ ∧
P ⊢ T casts v'' to w"
apply(rule_tac x="v'''" in exI)
apply auto
apply (rule converse_rtrancl_into_rtrancl)
by simp_all }
thus "∀h l h' l' v v'.
s = (h, l(V ↦ v')) ⟶
P ⊢ T casts v to v' ⟶
s' = (h', l') ⟶
(∃v'' w. P,E ⊢ ⟨{V:T; V:=Val v;; e},(h, l)⟩ →*
⟨{V:T; V:=Val v'';; e'},(h', l'(V := l V))⟩ ∧
P ⊢ T casts v'' to w)"
by auto
qed
lemma InitBlockReds:
"⟦P,E(V ↦ T) ⊢ ⟨e, (h,l(V↦v'))⟩ →* ⟨e', (h',l')⟩;
P ⊢ T casts v to v'; wf_prog wf_md P ⟧ ⟹
∃v'' w. P,E ⊢ ⟨{V:T := Val v; e}, (h,l)⟩ →*
⟨{V:T := Val v''; e'}, (h',l'(V:=(l V)))⟩ ∧
P ⊢ T casts v'' to w"
by(blast dest:InitBlockReds_aux)
lemma InitBlockRedsFinal:
assumes reds:"P,E(V ↦ T) ⊢ ⟨e,(h,l(V↦v'))⟩ →* ⟨e',(h',l')⟩"
and final:"final e'" and casts:"P ⊢ T casts v to v'"
and wf:"wf_prog wf_md P"
shows "P,E ⊢ ⟨{V:T := Val v; e},(h,l)⟩ →* ⟨e',(h', l'(V := l V))⟩"
proof -
from reds casts wf obtain v'' and w
where steps:"P,E ⊢ ⟨{V:T := Val v; e},(h,l)⟩ →*
⟨{V:T := Val v''; e'}, (h',l'(V:=(l V)))⟩"
and casts':"P ⊢ T casts v'' to w"
by (auto dest:InitBlockReds)
from final casts casts'
have step:"P,E ⊢ ⟨{V:T := Val v''; e'}, (h',l'(V:=(l V)))⟩ →
⟨e',(h',l'(V := l V))⟩"
by(auto elim!:finalE intro:RedInitBlock InitBlockThrow)
from step steps show ?thesis
by(fastforce intro:rtrancl_into_rtrancl)
qed
subsection ‹Block›
lemma BlockRedsFinal:
assumes reds: "P,E(V ↦ T) ⊢ ⟨e⇩0,s⇩0⟩ →* ⟨e⇩2,(h⇩2,l⇩2)⟩" and fin: "final e⇩2"
and wf:"wf_prog wf_md P"
shows "⋀h⇩0 l⇩0. s⇩0 = (h⇩0,l⇩0(V:=None)) ⟹ P,E ⊢ ⟨{V:T; e⇩0},(h⇩0,l⇩0)⟩ →* ⟨e⇩2,(h⇩2,l⇩2(V:=l⇩0 V))⟩"
using reds
proof (induct rule:converse_rtrancl_induct2)
case refl thus ?case
by(fastforce intro:finalE[OF fin] RedBlock BlockThrow
simp del:fun_upd_apply)
next
case (step e⇩0 s⇩0 e⇩1 s⇩1)
have Red: "((e⇩0,s⇩0),e⇩1,s⇩1) ∈ Red P (E(V ↦ T))"
and reds: "P,E(V ↦ T) ⊢ ⟨e⇩1,s⇩1⟩ →* ⟨e⇩2,(h⇩2,l⇩2)⟩"
and IH: "⋀h l. s⇩1 = (h,l(V := None))
⟹ P,E ⊢ ⟨{V:T; e⇩1},(h,l)⟩ →* ⟨e⇩2,(h⇩2, l⇩2(V := l V))⟩"
and s⇩0: "s⇩0 = (h⇩0, l⇩0(V := None))" by fact+
obtain h⇩1 l⇩1 where s⇩1: "s⇩1 = (h⇩1,l⇩1)" by fastforce
show ?case
proof cases
assume "assigned V e⇩0"
then obtain v e where e⇩0: "e⇩0 = V:= Val v;; e"
by (unfold assigned_def)blast
from Red e⇩0 s⇩0 obtain v' where e⇩1: "e⇩1 = Val v';;e"
and s⇩1: "s⇩1 = (h⇩0, l⇩0(V ↦ v'))" and casts:"P ⊢ T casts v to v'"
by auto
from e⇩1 fin have "e⇩1 ≠ e⇩2" by (auto simp:final_def)
then obtain e' s' where red1: "P,E(V ↦ T) ⊢ ⟨e⇩1,s⇩1⟩ → ⟨e',s'⟩"
and reds': "P,E(V ↦ T) ⊢ ⟨e',s'⟩ →* ⟨e⇩2,(h⇩2,l⇩2)⟩"
using converse_rtranclE2[OF reds] by simp blast
from red1 e⇩1 have es': "e' = e" "s' = s⇩1" by auto
show ?thesis using e⇩0 s⇩1 es' reds'
by(fastforce intro!: InitBlockRedsFinal[OF _ fin casts wf]
simp del:fun_upd_apply)
next
assume unass: "¬ assigned V e⇩0"
show ?thesis
proof (cases "l⇩1 V")
assume None: "l⇩1 V = None"
hence "P,E ⊢ ⟨{V:T; e⇩0},(h⇩0,l⇩0)⟩ → ⟨{V:T; e⇩1},(h⇩1, l⇩1(V := l⇩0 V))⟩"
using s⇩0 s⇩1 Red by(simp add: BlockRedNone[OF _ _ unass])
moreover
have "P,E ⊢ ⟨{V:T; e⇩1},(h⇩1, l⇩1(V := l⇩0 V))⟩ →* ⟨e⇩2,(h⇩2, l⇩2(V := l⇩0 V))⟩"
using IH[of _ "l⇩1(V := l⇩0 V)"] s⇩1 None by(simp add:fun_upd_idem)
ultimately show ?case
by(rule_tac b="({V:T; e⇩1},(h⇩1, l⇩1(V := l⇩0 V)))" in converse_rtrancl_into_rtrancl,simp)
next
fix v assume Some: "l⇩1 V = Some v"
with Red Some s⇩0 s⇩1 wf
have casts:"P ⊢ T casts v to v"
by(fastforce intro:None_lcl_casts_values)
from Some
have "P,E ⊢ ⟨{V:T;e⇩0},(h⇩0,l⇩0)⟩ → ⟨{V:T := Val v; e⇩1},(h⇩1,l⇩1(V := l⇩0 V))⟩"
using s⇩0 s⇩1 Red by(simp add: BlockRedSome[OF _ _ unass])
moreover
have "P,E ⊢ ⟨{V:T := Val v; e⇩1},(h⇩1,l⇩1(V:= l⇩0 V))⟩ →*
⟨e⇩2,(h⇩2,l⇩2(V:=l⇩0 V))⟩"
using InitBlockRedsFinal[OF _ fin casts wf,of _ _ "l⇩1(V:=l⇩0 V)" V]
Some reds s⇩1
by (simp add:fun_upd_idem)
ultimately show ?case
by(rule_tac b="({V:T; V:=Val v;; e⇩1},(h⇩1, l⇩1(V := l⇩0 V)))" in converse_rtrancl_into_rtrancl,simp)
qed
qed
qed
subsection ‹List›
lemma ListReds1:
"P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ⟹ P,E ⊢ ⟨e#es,s⟩ [→]* ⟨e' # es,s'⟩"
apply(erule rtrancl_induct2)
apply blast
apply(erule rtrancl_into_rtrancl)
apply(simp add:ListRed1)
done
lemma ListReds2:
"P,E ⊢ ⟨es,s⟩ [→]* ⟨es',s'⟩ ⟹ P,E ⊢ ⟨Val v # es,s⟩ [→]* ⟨Val v # es',s'⟩"
apply(erule rtrancl_induct2)
apply blast
apply(erule rtrancl_into_rtrancl)
apply(simp add:ListRed2)
done
lemma ListRedsVal:
"⟦ P,E ⊢ ⟨e,s⇩0⟩ →* ⟨Val v,s⇩1⟩; P,E ⊢ ⟨es,s⇩1⟩ [→]* ⟨es',s⇩2⟩ ⟧
⟹ P,E ⊢ ⟨e#es,s⇩0⟩ [→]* ⟨Val v # es',s⇩2⟩"
apply(rule rtrancl_trans)
apply(erule ListReds1)
apply(erule ListReds2)
done
subsection ‹Call›
text‹First a few lemmas on what happens to free variables during redction.›
lemma assumes wf: "wwf_prog P"
shows Red_fv: "P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',(h',l')⟩ ⟹ fv e' ⊆ fv e"
and "P,E ⊢ ⟨es,(h,l)⟩ [→] ⟨es',(h',l')⟩ ⟹ fvs es' ⊆ fvs es"
proof (induct rule:red_reds_inducts)
case (RedCall h l a C S Cs M Ts' T' pns' body' Ds Ts T pns body Cs' vs bs new_body E)
hence "fv body ⊆ {this} ∪ set pns"
using assms by(fastforce dest!:select_method_wf_mdecl simp:wf_mdecl_def)
with RedCall.hyps show ?case
by(cases T') auto
next
case (RedStaticCall Cs C Cs'' M Ts T pns body Cs' Ds vs E a a' b)
hence "fv body ⊆ {this} ∪ set pns"
using assms by(fastforce dest!:has_least_wf_mdecl simp:wf_mdecl_def)
with RedStaticCall.hyps show ?case
by auto
qed auto
lemma Red_dom_lcl:
"P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',(h',l')⟩ ⟹ dom l' ⊆ dom l ∪ fv e" and
"P,E ⊢ ⟨es,(h,l)⟩ [→] ⟨es',(h',l')⟩ ⟹ dom l' ⊆ dom l ∪ fvs es"
proof (induct rule:red_reds_inducts)
case RedLAss thus ?case by(force split:if_splits)
next
case CallParams thus ?case by(force split:if_splits)
next
case BlockRedNone thus ?case by clarsimp (fastforce split:if_splits)
next
case BlockRedSome thus ?case by clarsimp (fastforce split:if_splits)
next
case InitBlockRed thus ?case by clarsimp (fastforce split:if_splits)
qed auto
lemma Reds_dom_lcl:
"⟦ wwf_prog P; P,E ⊢ ⟨e,(h,l)⟩ →* ⟨e',(h',l')⟩ ⟧ ⟹ dom l' ⊆ dom l ∪ fv e"
apply(erule converse_rtrancl_induct_red)
apply blast
apply(blast dest: Red_fv Red_dom_lcl)
done
text‹Now a few lemmas on the behaviour of blocks during reduction.›
lemma override_on_upd_lemma:
"(override_on f (g(a↦b)) A)(a := g a) = override_on f g (insert a A)"
apply(rule ext)
apply(simp add:override_on_def)
done
declare fun_upd_apply[simp del] map_upds_twist[simp del]
lemma assumes wf:"wf_prog wf_md P"
shows blocksReds:
"⋀l⇩0 E vs'. ⟦ length Vs = length Ts; length vs = length Ts;
distinct Vs; P ⊢ Ts Casts vs to vs';
P,E(Vs [↦] Ts) ⊢ ⟨e, (h⇩0,l⇩0(Vs [↦] vs'))⟩ →* ⟨e', (h⇩1,l⇩1)⟩ ⟧
⟹ ∃vs''. P,E ⊢ ⟨blocks(Vs,Ts,vs,e), (h⇩0,l⇩0)⟩ →*
⟨blocks(Vs,Ts,vs'',e'), (h⇩1,override_on l⇩1 l⇩0 (set Vs))⟩ ∧
(∃ws. P ⊢ Ts Casts vs'' to ws) ∧ length vs = length vs''"
proof(induct Vs Ts vs e rule:blocks_old_induct)
case (5 V Vs T Ts v vs e)
have length1:"length (V#Vs) = length (T#Ts)"
and length2:"length (v#vs) = length (T#Ts)"
and dist:"distinct (V#Vs)"
and casts:"P ⊢ (T#Ts) Casts (v#vs) to vs'"
and reds:"P,E(V#Vs [↦] T#Ts) ⊢ ⟨e,(h⇩0,l⇩0(V#Vs [↦] vs'))⟩ →* ⟨e',(h⇩1,l⇩1)⟩"
and IH:"⋀l⇩0 E vs''. ⟦length Vs = length Ts; length vs = length Ts;
distinct Vs; P ⊢ Ts Casts vs to vs'';
P,E(Vs [↦] Ts) ⊢ ⟨e,(h⇩0,l⇩0(Vs [↦] vs''))⟩ →* ⟨e',(h⇩1,l⇩1)⟩⟧
⟹ ∃vs''. P,E ⊢ ⟨blocks (Vs,Ts,vs,e),(h⇩0,l⇩0)⟩ →*
⟨blocks (Vs,Ts,vs'',e'),(h⇩1, override_on l⇩1 l⇩0 (set Vs))⟩ ∧
(∃ws. P ⊢ Ts Casts vs'' to ws) ∧ length vs = length vs''" by fact+
from length1 have length1':"length Vs = length Ts" by simp
from length2 have length2':"length vs = length Ts" by simp
from dist have dist':"distinct Vs" by simp
from casts obtain x xs where vs':"vs' = x#xs"
by(cases vs',auto dest:length_Casts_vs')
with reds
have reds':"P,E(V ↦ T)(Vs [↦] Ts) ⊢ ⟨e,(h⇩0,l⇩0(V ↦ x)(Vs [↦] xs))⟩
→* ⟨e',(h⇩1,l⇩1)⟩"
by simp
from casts vs' have casts':"P ⊢ Ts Casts vs to xs"
and cast':"P ⊢ T casts v to x"
by(auto elim:Casts_to.cases)
from IH[OF length1' length2' dist' casts' reds']
obtain vs'' ws
where blocks:"P,E(V ↦ T) ⊢ ⟨blocks (Vs, Ts, vs, e),(h⇩0, l⇩0(V ↦ x))⟩ →*
⟨blocks (Vs, Ts, vs'', e'),(h⇩1, override_on l⇩1 (l⇩0(V ↦ x)) (set Vs))⟩"
and castsws:"P ⊢ Ts Casts vs'' to ws"
and lengthvs'':"length vs = length vs''" by auto
from InitBlockReds[OF blocks cast' wf] obtain v'' w where
blocks':"P,E ⊢ ⟨{V:T; V:=Val v;; blocks (Vs, Ts, vs, e)},(h⇩0, l⇩0)⟩ →*
⟨{V:T; V:=Val v'';; blocks (Vs, Ts, vs'', e')},
(h⇩1, (override_on l⇩1 (l⇩0(V ↦ x)) (set Vs))(V := l⇩0 V))⟩"
and "P ⊢ T casts v'' to w" by auto
with castsws have "P ⊢ T#Ts Casts v''#vs'' to w#ws"
by -(rule Casts_Cons)
with blocks' lengthvs'' show ?case
by(rule_tac x="v''#vs''" in exI,auto simp:override_on_upd_lemma)
next
case (6 e)
have casts:"P ⊢ [] Casts [] to vs'"
and step:"P,E([] [↦] []) ⊢ ⟨e,(h⇩0, l⇩0([] [↦] vs'))⟩ →* ⟨e',(h⇩1, l⇩1)⟩" by fact+
from casts have "vs' = []" by(fastforce dest:length_Casts_vs')
with step have "P,E ⊢ ⟨e,(h⇩0, l⇩0)⟩ →* ⟨e',(h⇩1, l⇩1)⟩" by simp
with casts show ?case by auto
qed simp_all
lemma assumes wf:"wf_prog wf_md P"
shows blocksFinal:
"⋀E l vs'. ⟦ length Vs = length Ts; length vs = length Ts;
final e; P ⊢ Ts Casts vs to vs' ⟧ ⟹
P,E ⊢ ⟨blocks(Vs,Ts,vs,e), (h,l)⟩ →* ⟨e, (h,l)⟩"
proof(induct Vs Ts vs e rule:blocks_old_induct)
case (5 V Vs T Ts v vs e)
have length1:"length (V # Vs) = length (T # Ts)"
and length2:"length (v # vs) = length (T # Ts)"
and final:"final e" and casts:"P ⊢ T # Ts Casts v # vs to vs'"
and IH:"⋀E l vs'. ⟦length Vs = length Ts; length vs = length Ts; final e;
P ⊢ Ts Casts vs to vs' ⟧
⟹ P,E ⊢ ⟨blocks (Vs, Ts, vs, e),(h, l)⟩ →* ⟨e,(h, l)⟩" by fact+
from length1 length2
have length1':"length Vs = length Ts" and length2':"length vs = length Ts"
by simp_all
from casts obtain x xs where vs':"vs' = x#xs"
by(cases vs',auto dest:length_Casts_vs')
with casts have casts':"P ⊢ Ts Casts vs to xs"
and cast':"P ⊢ T casts v to x"
by(auto elim:Casts_to.cases)
from InitBlockReds[OF IH[OF length1' length2' final casts'] cast' wf, of V l]
obtain v'' w
where blocks:"P,E ⊢ ⟨{V:T; V:=Val v;; blocks (Vs, Ts, vs, e)},(h, l)⟩ →*
⟨{V:T; V:=Val v'';; e},(h,l)⟩"
and "P ⊢ T casts v'' to w" by auto blast
with final have "P,E ⊢ ⟨{V:T; V:=Val v'';; e},(h,l)⟩ → ⟨e,(h,l)⟩"
by(auto elim!:finalE intro:RedInitBlock InitBlockThrow)
with blocks show ?case
by -(rule_tac b="({V:T; V:=Val v'';; e},(h, l))" in rtrancl_into_rtrancl,simp_all)
qed auto
lemma assumes wfmd:"wf_prog wf_md P"
and wf: "length Vs = length Ts" "length vs = length Ts" "distinct Vs"
and casts:"P ⊢ Ts Casts vs to vs'"
and reds: "P,E(Vs [↦] Ts) ⊢ ⟨e, (h⇩0, l⇩0(Vs [↦] vs'))⟩ →* ⟨e', (h⇩1, l⇩1)⟩"
and fin: "final e'" and l2: "l⇩2 = override_on l⇩1 l⇩0 (set Vs)"
shows blocksRedsFinal: "P,E ⊢ ⟨blocks(Vs,Ts,vs,e), (h⇩0, l⇩0)⟩ →* ⟨e', (h⇩1,l⇩2)⟩"
proof -
obtain vs'' ws where blocks:"P,E ⊢ ⟨blocks(Vs,Ts,vs,e), (h⇩0, l⇩0)⟩ →*
⟨blocks(Vs,Ts,vs'',e'), (h⇩1,l⇩2)⟩"
and length:"length vs = length vs''"
and casts':"P ⊢ Ts Casts vs'' to ws"
using l2 blocksReds[OF wfmd wf casts reds]
by auto
have "P,E ⊢ ⟨blocks(Vs,Ts,vs'',e'), (h⇩1,l⇩2)⟩ →* ⟨e', (h⇩1,l⇩2)⟩"
using blocksFinal[OF wfmd _ _ fin casts'] wf length by simp
with blocks show ?thesis by simp
qed
text‹An now the actual method call reduction lemmas.›
lemma CallRedsObj:
"P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ⟹
P,E ⊢ ⟨Call e Copt M es,s⟩ →* ⟨Call e' Copt M es,s'⟩"
apply(erule rtrancl_induct2)
apply blast
apply(erule rtrancl_into_rtrancl)
apply(simp add:CallObj)
done
lemma CallRedsParams:
"P,E ⊢ ⟨es,s⟩ [→]* ⟨es',s'⟩ ⟹
P,E ⊢ ⟨Call (Val v) Copt M es,s⟩ →* ⟨Call (Val v) Copt M es',s'⟩"
apply(erule rtrancl_induct2)
apply blast
apply(erule rtrancl_into_rtrancl)
apply(simp add:CallParams)
done
lemma cast_lcl:
"P,E ⊢ ⟨⦇C⦈(Val v),(h,l)⟩ → ⟨Val v',(h,l)⟩ ⟹
P,E ⊢ ⟨⦇C⦈(Val v),(h,l')⟩ → ⟨Val v',(h,l')⟩"
apply(erule red.cases)
apply(auto intro:red_reds.intros)
apply(subgoal_tac "P,E ⊢ ⟨⦇C⦈ref (a,Cs@[C]@Cs'),(h,l')⟩ → ⟨ref (a,Cs@[C]),(h,l')⟩")
apply simp
apply(rule RedStaticDownCast)
done
lemma cast_env:
"P,E ⊢ ⟨⦇C⦈(Val v),(h,l)⟩ → ⟨Val v',(h,l)⟩ ⟹
P,E' ⊢ ⟨⦇C⦈(Val v),(h,l)⟩ → ⟨Val v',(h,l)⟩"
apply(erule red.cases)
apply(auto intro:red_reds.intros)
apply(subgoal_tac "P,E' ⊢ ⟨⦇C⦈ref (a,Cs@[C]@Cs'),(h,l)⟩ → ⟨ref (a,Cs@[C]),(h,l)⟩")
apply simp
apply(rule RedStaticDownCast)
done
lemma Cast_step_Cast_or_fin:
"P,E ⊢ ⟨⦇C⦈e,s⟩ →* ⟨e',s'⟩ ⟹ final e' ∨ (∃e''. e' = ⦇C⦈e'')"
by(induct rule:rtrancl_induct2,auto elim:red.cases simp:final_def)
lemma Cast_red:"P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ⟹
(⋀e⇩1. ⟦e = ⦇C⦈e⇩0; e' = ⦇C⦈e⇩1⟧ ⟹ P,E ⊢ ⟨e⇩0,s⟩ →* ⟨e⇩1,s'⟩)"
proof(induct rule:rtrancl_induct2)
case refl thus ?case by simp
next
case (step e'' s'' e' s')
have step:"P,E ⊢ ⟨e,s⟩ →* ⟨e'',s''⟩"
and Red:"((e'', s''), e', s') ∈ Red P E"
and cast:"e = ⦇C⦈e⇩0" and cast':"e' = ⦇C⦈e⇩1"
and IH:"⋀e⇩1. ⟦e = ⦇C⦈e⇩0; e'' = ⦇C⦈e⇩1⟧ ⟹ P,E ⊢ ⟨e⇩0,s⟩ →* ⟨e⇩1,s''⟩" by fact+
from Red have red:"P,E ⊢ ⟨e'',s''⟩ → ⟨e',s'⟩" by simp
from step cast have "final e'' ∨ (∃ex. e'' = ⦇C⦈ex)"
by simp(rule Cast_step_Cast_or_fin)
thus ?case
proof(rule disjE)
assume "final e''"
with red show ?thesis by(auto simp:final_def)
next
assume "∃ex. e'' = ⦇C⦈ex"
then obtain ex where e'':"e'' = ⦇C⦈ex" by blast
with cast' red have "P,E ⊢ ⟨ex,s''⟩ → ⟨e⇩1,s'⟩"
by(auto elim:red.cases)
with IH[OF cast e''] show ?thesis
by(rule_tac b="(ex,s'')" in rtrancl_into_rtrancl,simp_all)
qed
qed
lemma Cast_final:"⟦P,E ⊢ ⟨⦇C⦈e,s⟩ →* ⟨e',s'⟩; final e'⟧ ⟹
∃e'' s''. P,E ⊢ ⟨e,s⟩ →* ⟨e'',s''⟩ ∧ P,E ⊢ ⟨⦇C⦈e'',s''⟩ → ⟨e',s'⟩ ∧ final e''"
proof(induct rule:rtrancl_induct2)
case refl thus ?case by (simp add:final_def)
next
case (step e'' s'' e' s')
have step:"P,E ⊢ ⟨⦇C⦈e,s⟩ →* ⟨e'',s''⟩"
and Red:"((e'', s''), e', s') ∈ Red P E"
and final:"final e'"
and IH:"final e'' ⟹
∃ex sx. P,E ⊢ ⟨e,s⟩ →* ⟨ex,sx⟩ ∧ P,E ⊢ ⟨⦇C⦈ex,sx⟩ → ⟨e'',s''⟩ ∧ final ex" by fact+
from Red have red:"P,E ⊢ ⟨e'',s''⟩ → ⟨e',s'⟩" by simp
from step have "final e'' ∨ (∃ex. e'' = ⦇C⦈ex)" by(rule Cast_step_Cast_or_fin)
thus ?case
proof(rule disjE)
assume "final e''"
with red show ?thesis by(auto simp:final_def)
next
assume "∃ex. e'' = ⦇C⦈ex"
then obtain ex where e'':"e'' = ⦇C⦈ex" by blast
with red final have final':"final ex"
by(auto elim:red.cases simp:final_def)
from step e'' have "P,E ⊢ ⟨e,s⟩ →* ⟨ex,s''⟩"
by(fastforce intro:Cast_red)
with e'' red final' show ?thesis by blast
qed
qed
lemma Cast_final_eq:
assumes red:"P,E ⊢ ⟨⦇C⦈e,(h,l)⟩ → ⟨e',(h,l)⟩"
and final:"final e" and final':"final e'"
shows "P,E' ⊢ ⟨⦇C⦈e,(h,l')⟩ → ⟨e',(h,l')⟩"
proof -
from red final show ?thesis
proof(auto simp:final_def)
fix v assume "P,E ⊢ ⟨⦇C⦈(Val v),(h,l)⟩ → ⟨e',(h,l)⟩"
with final' show "P,E' ⊢ ⟨⦇C⦈(Val v),(h,l')⟩ → ⟨e',(h,l')⟩"
proof(auto simp:final_def)
fix v' assume "P,E ⊢ ⟨⦇C⦈(Val v),(h,l)⟩ → ⟨Val v',(h,l)⟩"
thus "P,E' ⊢ ⟨⦇C⦈(Val v),(h,l')⟩ → ⟨Val v',(h,l')⟩"
by(auto intro:cast_lcl cast_env)
next
fix a Cs assume "P,E ⊢ ⟨⦇C⦈(Val v),(h,l)⟩ → ⟨Throw (a,Cs),(h,l)⟩"
thus "P,E' ⊢ ⟨⦇C⦈(Val v),(h,l')⟩ → ⟨Throw (a,Cs),(h,l')⟩"
by(auto elim:red.cases intro!:RedStaticCastFail)
qed
next
fix a Cs assume "P,E ⊢ ⟨⦇C⦈(Throw (a,Cs)),(h,l)⟩ → ⟨e',(h,l)⟩"
with final' show "P,E' ⊢ ⟨⦇C⦈(Throw (a,Cs)),(h,l')⟩ → ⟨e',(h,l')⟩"
proof(auto simp:final_def)
fix v assume "P,E ⊢ ⟨⦇C⦈(Throw (a,Cs)),(h,l)⟩ → ⟨Val v,(h,l)⟩"
thus "P,E' ⊢ ⟨⦇C⦈(Throw (a,Cs)),(h,l')⟩ → ⟨Val v,(h,l')⟩"
by(auto elim:red.cases)
next
fix a' Cs'
assume "P,E ⊢ ⟨⦇C⦈(Throw (a,Cs)),(h,l)⟩ → ⟨Throw (a',Cs'),(h,l)⟩"
thus "P,E' ⊢ ⟨⦇C⦈(Throw (a,Cs)),(h,l')⟩ → ⟨Throw (a',Cs'),(h,l')⟩"
by(auto elim:red.cases intro:red_reds.StaticCastThrow)
qed
qed
qed
lemma CallRedsFinal:
assumes wwf: "wwf_prog P"
and "P,E ⊢ ⟨e,s⇩0⟩ →* ⟨ref(a,Cs),s⇩1⟩"
"P,E ⊢ ⟨es,s⇩1⟩ [→]* ⟨map Val vs,(h⇩2,l⇩2)⟩"
and hp: "h⇩2 a = Some(C,S)"
and "method": "P ⊢ last Cs has least M = (Ts',T',pns',body') via Ds"
and select: "P ⊢ (C,Cs@⇩pDs) selects M = (Ts,T,pns,body) via Cs'"
and size: "size vs = size pns"
and casts: "P ⊢ Ts Casts vs to vs'"
and l⇩2': "l⇩2' = [this ↦ Ref(a,Cs'), pns[↦]vs']"
and body_case:"new_body = (case T' of Class D ⇒ ⦇D⦈body | _ ⇒ body)"
and body: "P,E(this ↦ Class (last Cs'), pns [↦] Ts) ⊢ ⟨new_body,(h⇩2,l⇩2')⟩ →* ⟨ef,(h⇩3,l⇩3)⟩"
and final:"final ef"
shows "P,E ⊢ ⟨e∙M(es), s⇩0⟩ →* ⟨ef,(h⇩3,l⇩2)⟩"
proof -
have wf: "size Ts = size pns ∧ distinct pns ∧ this ∉ set pns"
and wt: "fv body ⊆ {this} ∪ set pns"
using assms by(fastforce dest!:select_method_wf_mdecl simp:wf_mdecl_def)+
have "dom l⇩3 ⊆ {this} ∪ set pns"
using Reds_dom_lcl[OF wwf body] wt l⇩2' set_take_subset body_case
by (cases T') force+
hence eql⇩2: "override_on (l⇩2++l⇩3) l⇩2 ({this} ∪ set pns) = l⇩2"
by(fastforce simp add:map_add_def override_on_def fun_eq_iff)
from wwf select have "is_class P (last Cs')"
by (auto elim!:SelectMethodDef.cases intro:Subobj_last_isClass
simp:LeastMethodDef_def FinalOverriderMethodDef_def
OverriderMethodDefs_def MinimalMethodDefs_def MethodDefs_def)
hence "P ⊢ Class (last Cs') casts Ref(a,Cs') to Ref(a,Cs')"
by(auto intro!:casts_ref Subobjs_Base simp:path_via_def appendPath_def)
with casts
have casts':"P ⊢ Class (last Cs')#Ts Casts Ref(a,Cs')#vs to Ref(a,Cs')#vs'"
by -(rule Casts_Cons)
have 1:"P,E ⊢ ⟨e∙M(es),s⇩0⟩ →* ⟨(ref(a,Cs))∙M(es),s⇩1⟩" by(rule CallRedsObj)(rule assms(2))
have 2:"P,E ⊢ ⟨(ref(a,Cs))∙M(es),s⇩1⟩ →*
⟨(ref(a,Cs))∙M(map Val vs),(h⇩2,l⇩2)⟩"
by(rule CallRedsParams)(rule assms(3))
from body[THEN Red_lcl_add, of l⇩2]
have body': "P,E(this ↦ Class (last Cs'), pns [↦] Ts) ⊢
⟨new_body,(h⇩2,l⇩2(this↦ Ref(a,Cs'), pns[↦]vs'))⟩ →* ⟨ef,(h⇩3,l⇩2++l⇩3)⟩"
by (simp add:l⇩2')
show ?thesis
proof(cases "∀C. T'≠ Class C")
case True
hence "P,E ⊢ ⟨(ref(a,Cs))∙M(map Val vs), (h⇩2,l⇩2)⟩ →
⟨blocks(this#pns,Class(last Cs')#Ts,Ref(a,Cs')#vs,body), (h⇩2,l⇩2)⟩"
using hp "method" select size wf
by -(rule RedCall,auto,cases T',auto)
hence 3:"P,E ⊢ ⟨(ref(a,Cs))∙M(map Val vs), (h⇩2,l⇩2)⟩ →*
⟨blocks(this#pns,Class(last Cs')#Ts,Ref(a,Cs')#vs,body), (h⇩2,l⇩2)⟩"
by(simp add:r_into_rtrancl)
have "P,E ⊢ ⟨blocks(this#pns,Class(last Cs')#Ts,Ref(a,Cs')#vs,body),(h⇩2,l⇩2)⟩ →*
⟨ef,(h⇩3,override_on (l⇩2++l⇩3) l⇩2 ({this} ∪ set pns))⟩"
using True wf body' wwf size final casts' body_case
by -(rule_tac vs'="Ref(a,Cs')#vs'" in blocksRedsFinal,simp_all,cases T',auto)
with 1 2 3 show ?thesis using eql⇩2
by simp
next
case False
then obtain D where T':"T' = Class D" by auto
with final body' body_case obtain s' e' where
body'':"P,E(this ↦ Class (last Cs'),pns [↦] Ts) ⊢
⟨body,(h⇩2,l⇩2(this↦ Ref(a,Cs'), pns[↦]vs'))⟩ →* ⟨e',s'⟩"
and final':"final e'"
and cast:"P,E(this ↦ Class (last Cs'), pns [↦] Ts) ⊢ ⟨⦇D⦈e',s'⟩ →
⟨ef,(h⇩3,l⇩2++l⇩3)⟩"
by(cases T')(auto dest:Cast_final)
from T' have "P,E ⊢ ⟨(ref(a,Cs))∙M(map Val vs), (h⇩2,l⇩2)⟩ →
⟨⦇D⦈blocks(this#pns,Class(last Cs')#Ts,Ref(a,Cs')#vs,body), (h⇩2,l⇩2)⟩"
using hp "method" select size wf
by -(rule RedCall,auto)
hence 3:"P,E ⊢ ⟨(ref(a,Cs))∙M(map Val vs), (h⇩2,l⇩2)⟩ →*
⟨⦇D⦈blocks(this#pns,Class(last Cs')#Ts,Ref(a,Cs')#vs,body),(h⇩2,l⇩2)⟩"
by(simp add:r_into_rtrancl)
from cast final have eq:"s' = (h⇩3,l⇩2++l⇩3)"
by(auto elim:red.cases simp:final_def)
hence "P,E ⊢ ⟨blocks(this#pns, Class (last Cs')#Ts, Ref(a,Cs')#vs,body), (h⇩2,l⇩2)⟩
→* ⟨e',(h⇩3,override_on (l⇩2++l⇩3) l⇩2 ({this} ∪ set pns))⟩"
using wf body'' wwf size final' casts'
by -(rule_tac vs'="Ref(a,Cs')#vs'" in blocksRedsFinal,simp_all)
hence "P,E ⊢ ⟨⦇D⦈(blocks(this#pns,Class(last Cs')#Ts,Ref(a,Cs')#vs,body)),(h⇩2,l⇩2)⟩
→* ⟨⦇D⦈e',(h⇩3,override_on (l⇩2++l⇩3) l⇩2 ({this} ∪ set pns))⟩"
by(rule StaticCastReds)
moreover
have "P,E ⊢ ⟨⦇D⦈e',(h⇩3,override_on (l⇩2++l⇩3) l⇩2 ({this} ∪ set pns))⟩ →
⟨ef,(h⇩3,override_on (l⇩2++l⇩3) l⇩2 ({this} ∪ set pns))⟩"
using eq cast final final'
by(fastforce intro:Cast_final_eq)
ultimately
have "P,E ⊢ ⟨⦇D⦈(blocks(this#pns, Class (last Cs')#Ts, Ref(a,Cs')#vs,body)),
(h⇩2,l⇩2)⟩ →* ⟨ef,(h⇩3,override_on (l⇩2++l⇩3) l⇩2 ({this} ∪ set pns))⟩"
by(rule_tac b="(⦇D⦈e',(h⇩3,override_on (l⇩2++l⇩3) l⇩2 ({this} ∪ set pns)))"
in rtrancl_into_rtrancl,simp_all)
with 1 2 3 show ?thesis using eql⇩2
by simp
qed
qed
lemma StaticCallRedsFinal:
assumes wwf: "wwf_prog P"
and "P,E ⊢ ⟨e,s⇩0⟩ →* ⟨ref(a,Cs),s⇩1⟩"
"P,E ⊢ ⟨es,s⇩1⟩ [→]* ⟨map Val vs,(h⇩2,l⇩2)⟩"
and path_unique: "P ⊢ Path (last Cs) to C unique"
and path_via: "P ⊢ Path (last Cs) to C via Cs''"
and Ds: "Ds = (Cs@⇩pCs'')@⇩pCs'"
and least: "P ⊢ C has least M = (Ts,T,pns,body) via Cs'"
and size: "size vs = size pns"
and casts: "P ⊢ Ts Casts vs to vs'"
and l⇩2': "l⇩2' = [this ↦ Ref(a,Ds), pns[↦]vs']"
and body: "P,E(this↦Class(last Ds), pns[↦]Ts) ⊢ ⟨body,(h⇩2,l⇩2')⟩ →* ⟨ef,(h⇩3,l⇩3)⟩"
and final:"final ef"
shows "P,E ⊢ ⟨e∙(C::)M(es), s⇩0⟩ →* ⟨ef,(h⇩3,l⇩2)⟩"
proof -
have wf: "size Ts = size pns ∧ distinct pns ∧ this ∉ set pns ∧
(∀T∈set Ts. is_type P T)"
and wt: "fv body ⊆ {this} ∪ set pns"
using assms by(fastforce dest!:has_least_wf_mdecl simp:wf_mdecl_def)+
have "dom l⇩3 ⊆ {this} ∪ set pns"
using Reds_dom_lcl[OF wwf body] wt l⇩2' set_take_subset
by force
hence eql⇩2: "override_on (l⇩2++l⇩3) l⇩2 ({this} ∪ set pns) = l⇩2"
by(fastforce simp add:map_add_def override_on_def fun_eq_iff)
from wwf least have "Cs' ≠ []"
by (auto elim!:Subobjs_nonempty simp:LeastMethodDef_def MethodDefs_def)
with Ds have "last Cs' = last Ds" by(fastforce intro:appendPath_last)
with wwf least have "is_class P (last Ds)"
by(auto dest:Subobj_last_isClass simp:LeastMethodDef_def MethodDefs_def)
hence "P ⊢ Class (last Ds) casts Ref(a,Ds) to Ref(a,Ds)"
by(auto intro!:casts_ref Subobjs_Base simp:path_via_def appendPath_def)
with casts
have casts':"P ⊢ Class (last Ds)#Ts Casts Ref(a,Ds)#vs to Ref(a,Ds)#vs'"
by -(rule Casts_Cons)
have 1:"P,E ⊢ ⟨e∙(C::)M(es),s⇩0⟩ →* ⟨(ref(a,Cs))∙(C::)M(es),s⇩1⟩"
by(rule CallRedsObj)(rule assms(2))
have 2:"P,E ⊢ ⟨(ref(a,Cs))∙(C::)M(es),s⇩1⟩ →*
⟨(ref(a,Cs))∙(C::)M(map Val vs),(h⇩2,l⇩2)⟩"
by(rule CallRedsParams)(rule assms(3))
from body[THEN Red_lcl_add, of l⇩2]
have body': "P,E(this↦Class(last Ds), pns[↦]Ts) ⊢
⟨body,(h⇩2,l⇩2(this↦ Ref(a,Ds), pns[↦]vs'))⟩ →* ⟨ef,(h⇩3,l⇩2++l⇩3)⟩"
by (simp add:l⇩2')
have "P,E ⊢ ⟨(ref(a,Cs))∙(C::)M(map Val vs), (h⇩2,l⇩2)⟩ →
⟨blocks(this#pns, Class (last Ds)#Ts, Ref(a,Ds)#vs, body), (h⇩2,l⇩2)⟩"
using path_unique path_via least size wf Ds
by -(rule RedStaticCall,auto)
hence 3:"P,E ⊢ ⟨(ref(a,Cs))∙(C::)M(map Val vs), (h⇩2,l⇩2)⟩ →*
⟨blocks(this#pns,Class(last Ds)#Ts,Ref(a,Ds)#vs,body), (h⇩2,l⇩2)⟩"
by(simp add:r_into_rtrancl)
have "P,E ⊢ ⟨blocks(this#pns,Class(last Ds)#Ts,Ref(a,Ds)#vs,body),(h⇩2,l⇩2)⟩ →*
⟨ef,(h⇩3,override_on (l⇩2++l⇩3) l⇩2 ({this} ∪ set pns))⟩"
using wf body' wwf size final casts'
by -(rule_tac vs'="Ref(a,Ds)#vs'" in blocksRedsFinal,simp_all)
with 1 2 3 show ?thesis using eql⇩2
by simp
qed
lemma CallRedsThrowParams:
"⟦ P,E ⊢ ⟨e,s⇩0⟩ →* ⟨Val v,s⇩1⟩;
P,E ⊢ ⟨es,s⇩1⟩ [→]* ⟨map Val vs⇩1 @ Throw ex # es⇩2,s⇩2⟩ ⟧
⟹ P,E ⊢ ⟨Call e Copt M es,s⇩0⟩ →* ⟨Throw ex,s⇩2⟩"
apply(rule rtrancl_trans)
apply(erule CallRedsObj)
apply(rule rtrancl_into_rtrancl)
apply(erule CallRedsParams)
apply(simp add:CallThrowParams)
done
lemma CallRedsThrowObj:
"P,E ⊢ ⟨e,s⇩0⟩ →* ⟨Throw ex,s⇩1⟩ ⟹ P,E ⊢ ⟨Call e Copt M es,s⇩0⟩ →* ⟨Throw ex,s⇩1⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule CallRedsObj)
apply(simp add:CallThrowObj)
done
lemma CallRedsNull:
"⟦ P,E ⊢ ⟨e,s⇩0⟩ →* ⟨null,s⇩1⟩; P,E ⊢ ⟨es,s⇩1⟩ [→]* ⟨map Val vs,s⇩2⟩ ⟧
⟹ P,E ⊢ ⟨Call e Copt M es,s⇩0⟩ →* ⟨THROW NullPointer,s⇩2⟩"
apply(rule rtrancl_trans)
apply(erule CallRedsObj)
apply(rule rtrancl_into_rtrancl)
apply(erule CallRedsParams)
apply(simp add:RedCallNull)
done
subsection ‹The main Theorem›
lemma assumes wwf: "wwf_prog P"
shows big_by_small: "P,E ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩ ⟹ P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩"
and bigs_by_smalls: "P,E ⊢ ⟨es,s⟩ [⇒] ⟨es',s'⟩ ⟹ P,E ⊢ ⟨es,s⟩ [→]* ⟨es',s'⟩"
proof (induct rule: eval_evals.inducts)
case New thus ?case by (auto simp:RedNew)
next
case NewFail thus ?case by (auto simp:RedNewFail)
next
case StaticUpCast thus ?case by(simp add:StaticUpCastReds)
next
case StaticDownCast thus ?case by(simp add:StaticDownCastReds)
next
case StaticCastNull thus ?case by(simp add:StaticCastRedsNull)
next
case StaticCastFail thus ?case by(simp add:StaticCastRedsFail)
next
case StaticCastThrow thus ?case by(auto dest!:eval_final simp:StaticCastRedsThrow)
next
case StaticUpDynCast thus ?case by(simp add:StaticUpDynCastReds)
next
case StaticDownDynCast thus ?case by(simp add:StaticDownDynCastReds)
next
case DynCast thus ?case by(fastforce intro:DynCastRedsRef)
next
case DynCastNull thus ?case by(simp add:DynCastRedsNull)
next
case DynCastFail thus ?case by(fastforce intro!:DynCastRedsFail)
next
case DynCastThrow thus ?case by(auto dest!:eval_final simp:DynCastRedsThrow)
next
case Val thus ?case by simp
next
case BinOp thus ?case by(fastforce simp:BinOpRedsVal)
next
case BinOpThrow1 thus ?case by(fastforce dest!:eval_final simp: BinOpRedsThrow1)
next
case BinOpThrow2 thus ?case by(fastforce dest!:eval_final simp: BinOpRedsThrow2)
next
case Var thus ?case by (fastforce simp:RedVar)
next
case LAss thus ?case by(fastforce simp: LAssRedsVal)
next
case LAssThrow thus ?case by(fastforce dest!:eval_final simp: LAssRedsThrow)
next
case FAcc thus ?case by(fastforce intro:FAccRedsVal)
next
case FAccNull thus ?case by(simp add:FAccRedsNull)
next
case FAccThrow thus ?case by(fastforce dest!:eval_final simp:FAccRedsThrow)
next
case FAss thus ?case by(fastforce simp:FAssRedsVal)
next
case FAssNull thus ?case by(fastforce simp:FAssRedsNull)
next
case FAssThrow1 thus ?case by(fastforce dest!:eval_final simp:FAssRedsThrow1)
next
case FAssThrow2 thus ?case by(fastforce dest!:eval_final simp:FAssRedsThrow2)
next
case CallObjThrow thus ?case by(fastforce dest!:eval_final simp:CallRedsThrowObj)
next
case CallNull thus ?case thm CallRedsNull by(simp add:CallRedsNull)
next
case CallParamsThrow thus ?case
by(fastforce dest!:evals_final simp:CallRedsThrowParams)
next
case (Call E e s⇩0 a Cs s⇩1 ps vs h⇩2 l⇩2 C S M Ts' T' pns' body' Ds Ts T pns
body Cs' vs' l⇩2' new_body e' h⇩3 l⇩3)
have IHe: "P,E ⊢ ⟨e,s⇩0⟩ →* ⟨ref(a,Cs),s⇩1⟩"
and IHes: "P,E ⊢ ⟨ps,s⇩1⟩ [→]* ⟨map Val vs,(h⇩2,l⇩2)⟩"
and h⇩2a: "h⇩2 a = Some(C,S)"
and "method": "P ⊢ last Cs has least M = (Ts',T',pns',body') via Ds"
and select: "P ⊢ (C,Cs@⇩pDs) selects M = (Ts,T,pns,body) via Cs'"
and same_length: "length vs = length pns"
and casts: "P ⊢ Ts Casts vs to vs'"
and l⇩2': "l⇩2' = [this ↦ Ref (a,Cs'), pns[↦]vs']"
and body_case: "new_body = (case T' of Class D ⇒ ⦇D⦈body | _ ⇒ body)"
and eval_body: "P,E(this ↦ Class (last Cs'), pns [↦] Ts) ⊢
⟨new_body,(h⇩2, l⇩2')⟩ ⇒ ⟨e',(h⇩3, l⇩3)⟩"
and IHbody: "P,E(this ↦ Class (last Cs'), pns [↦] Ts) ⊢
⟨new_body,(h⇩2, l⇩2')⟩ →* ⟨e',(h⇩3, l⇩3)⟩" by fact+
from wwf select same_length have lengthTs:"length Ts = length vs"
by (fastforce dest!:select_method_wf_mdecl simp:wf_mdecl_def)
show "P,E ⊢ ⟨e∙M(ps),s⇩0⟩ →* ⟨e',(h⇩3, l⇩2)⟩"
using "method" select same_length l⇩2' h⇩2a casts body_case
IHbody eval_final[OF eval_body]
by(fastforce intro!:CallRedsFinal[OF wwf IHe IHes])
next
case (StaticCall E e s⇩0 a Cs s⇩1 ps vs h⇩2 l⇩2 C Cs'' M Ts T pns body Cs'
Ds vs' l⇩2' e' h⇩3 l⇩3)
have IHe: "P,E ⊢ ⟨e,s⇩0⟩ →* ⟨ref(a,Cs),s⇩1⟩"
and IHes: "P,E ⊢ ⟨ps,s⇩1⟩ [→]* ⟨map Val vs,(h⇩2,l⇩2)⟩"
and path_unique: "P ⊢ Path last Cs to C unique"
and path_via: "P ⊢ Path last Cs to C via Cs''"
and least: "P ⊢ C has least M = (Ts, T, pns, body) via Cs'"
and Ds: "Ds = (Cs @⇩p Cs'') @⇩p Cs'"
and same_length: "length vs = length pns"
and casts: "P ⊢ Ts Casts vs to vs'"
and l⇩2': "l⇩2' = [this ↦ Ref (a,Ds), pns[↦]vs']"
and eval_body: "P,E(this ↦ Class (last Ds), pns [↦] Ts) ⊢
⟨body,(h⇩2, l⇩2')⟩ ⇒ ⟨e',(h⇩3, l⇩3)⟩"
and IHbody: "P,E(this ↦ Class (last Ds), pns [↦] Ts) ⊢
⟨body,(h⇩2, l⇩2')⟩ →* ⟨e',(h⇩3, l⇩3)⟩" by fact+
from wwf least same_length have lengthTs:"length Ts = length vs"
by (fastforce dest!:has_least_wf_mdecl simp:wf_mdecl_def)
show "P,E ⊢ ⟨e∙(C::)M(ps),s⇩0⟩ →* ⟨e',(h⇩3, l⇩2)⟩"
using path_unique path_via least Ds same_length l⇩2' casts
IHbody eval_final[OF eval_body]
by(fastforce intro!:StaticCallRedsFinal[OF wwf IHe IHes])
next
case Block with wwf show ?case by(fastforce simp: BlockRedsFinal dest:eval_final)
next
case Seq thus ?case by(fastforce simp:SeqReds2)
next
case SeqThrow thus ?case by(fastforce dest!:eval_final simp: SeqRedsThrow)
next
case CondT thus ?case by(fastforce simp:CondReds2T)
next
case CondF thus ?case by(fastforce simp:CondReds2F)
next
case CondThrow thus ?case by(fastforce dest!:eval_final simp:CondRedsThrow)
next
case WhileF thus ?case by(fastforce simp:WhileFReds)
next
case WhileT thus ?case by(fastforce simp: WhileTReds)
next
case WhileCondThrow thus ?case by(fastforce dest!:eval_final simp: WhileRedsThrow)
next
case WhileBodyThrow thus ?case by(fastforce dest!:eval_final simp: WhileTRedsThrow)
next
case Throw thus ?case by(fastforce simp:ThrowReds)
next
case ThrowNull thus ?case by(fastforce simp:ThrowRedsNull)
next
case ThrowThrow thus ?case by(fastforce dest!:eval_final simp:ThrowRedsThrow)
next
case Nil thus ?case by simp
next
case Cons thus ?case
by(fastforce intro!:Cons_eq_appendI[OF refl refl] ListRedsVal)
next
case ConsThrow thus ?case by(fastforce elim: ListReds1)
qed
subsection‹Big steps simulates small step›
text ‹The big step equivalent of ‹RedWhile›:›
lemma unfold_while:
"P,E ⊢ ⟨while(b) c,s⟩ ⇒ ⟨e',s'⟩ = P,E ⊢ ⟨if(b) (c;;while(b) c) else (unit),s⟩ ⇒ ⟨e',s'⟩"
proof
assume "P,E ⊢ ⟨while (b) c,s⟩ ⇒ ⟨e',s'⟩"
thus "P,E ⊢ ⟨if (b) (c;; while (b) c) else unit,s⟩ ⇒ ⟨e',s'⟩"
by cases (fastforce intro: eval_evals.intros)+
next
assume "P,E ⊢ ⟨if (b) (c;; while (b) c) else unit,s⟩ ⇒ ⟨e',s'⟩"
thus "P,E ⊢ ⟨while (b) c,s⟩ ⇒ ⟨e',s'⟩"
proof (cases)
fix ex
assume e': "e' = throw ex"
assume "P,E ⊢ ⟨b,s⟩ ⇒ ⟨throw ex,s'⟩"
hence "P,E ⊢ ⟨while(b) c,s⟩ ⇒ ⟨throw ex,s'⟩" by (rule WhileCondThrow)
with e' show ?thesis by simp
next
fix s⇩1
assume eval_false: "P,E ⊢ ⟨b,s⟩ ⇒ ⟨false,s⇩1⟩"
and eval_unit: "P,E ⊢ ⟨unit,s⇩1⟩ ⇒ ⟨e',s'⟩"
with eval_unit have "s' = s⇩1" "e' = unit" by (auto elim: eval_cases)
moreover from eval_false have "P,E ⊢ ⟨while (b) c,s⟩ ⇒ ⟨unit,s⇩1⟩"
by - (rule WhileF, simp)
ultimately show ?thesis by simp
next
fix s⇩1
assume eval_true: "P,E ⊢ ⟨b,s⟩ ⇒ ⟨true,s⇩1⟩"
and eval_rest: "P,E ⊢ ⟨c;; while (b) c,s⇩1⟩⇒⟨e',s'⟩"
from eval_rest show ?thesis
proof (cases)
fix s⇩2 v⇩1
assume "P,E ⊢ ⟨c,s⇩1⟩ ⇒ ⟨Val v⇩1,s⇩2⟩" "P,E ⊢ ⟨while (b) c,s⇩2⟩ ⇒ ⟨e',s'⟩"
with eval_true show "P,E ⊢ ⟨while(b) c,s⟩ ⇒ ⟨e',s'⟩" by (rule WhileT)
next
fix ex
assume "P,E ⊢ ⟨c,s⇩1⟩ ⇒ ⟨throw ex,s'⟩" "e' = throw ex"
with eval_true show "P,E ⊢ ⟨while(b) c,s⟩ ⇒ ⟨e',s'⟩"
by (iprover intro: WhileBodyThrow)
qed
qed
qed
lemma blocksEval:
"⋀Ts vs l l' E. ⟦size ps = size Ts; size ps = size vs;
P,E ⊢ ⟨blocks(ps,Ts,vs,e),(h,l)⟩ ⇒ ⟨e',(h',l')⟩ ⟧
⟹ ∃ l'' vs'. P,E(ps [↦] Ts) ⊢ ⟨e,(h,l(ps[↦]vs'))⟩ ⇒ ⟨e',(h',l'')⟩ ∧
P ⊢ Ts Casts vs to vs' ∧ length vs' = length vs"
proof (induct ps)
case Nil then show ?case by(fastforce intro:Casts_Nil)
next
case (Cons p ps')
have length_eqs: "length (p # ps') = length Ts"
"length (p # ps') = length vs"
and IH:"⋀Ts vs l l' E. ⟦length ps' = length Ts; length ps' = length vs;
P,E ⊢ ⟨blocks (ps',Ts,vs,e),(h,l)⟩ ⇒ ⟨e',(h',l')⟩⟧
⟹ ∃l'' vs'. P,E(ps' [↦] Ts) ⊢ ⟨e,(h,l(ps' [↦] vs'))⟩ ⇒ ⟨e',(h', l'')⟩ ∧
P ⊢ Ts Casts vs to vs' ∧ length vs' = length vs" by fact+
then obtain T Ts' where Ts: "Ts = T#Ts'" by (cases "Ts") simp
obtain v vs' where vs: "vs = v#vs'" using length_eqs by (cases "vs") simp
with length_eqs Ts have length1:"length ps' = length Ts'"
and length2:"length ps' = length vs'" by simp_all
have "P,E ⊢ ⟨blocks (p # ps', Ts, vs, e),(h,l)⟩ ⇒ ⟨e',(h', l')⟩" by fact
with Ts vs
have blocks:"P,E ⊢ ⟨{p:T := Val v; blocks (ps',Ts',vs',e)},(h,l)⟩ ⇒ ⟨e',(h',l')⟩"
by simp
then obtain l''' v' where
eval_ps': "P,E(p ↦ T) ⊢ ⟨blocks (ps',Ts',vs',e),(h,l(p↦v'))⟩ ⇒ ⟨e',(h',l''')⟩"
and l''': "l'=l'''(p:=l p)"
and casts:"P ⊢ T casts v to v'"
by(auto elim!: eval_cases simp:fun_upd_same)
from IH[OF length1 length2 eval_ps'] obtain l'' vs'' where
"P,E(p ↦ T)(ps' [↦] Ts') ⊢ ⟨e,(h, l(p↦v')(ps'[↦]vs''))⟩ ⇒
⟨e',(h',l'')⟩"
and "P ⊢ Ts' Casts vs' to vs''"
and "length vs'' = length vs'" by auto
with Ts vs casts show ?case
by -(rule_tac x="l''" in exI,rule_tac x="v'#vs''" in exI,simp,
rule Casts_Cons)
qed
lemma CastblocksEval:
"⋀Ts vs l l' E. ⟦size ps = size Ts; size ps = size vs;
P,E ⊢ ⟨⦇C'⦈(blocks(ps,Ts,vs,e)),(h,l)⟩ ⇒ ⟨e',(h',l')⟩ ⟧
⟹ ∃ l'' vs'. P,E(ps [↦] Ts) ⊢ ⟨⦇C'⦈e,(h,l(ps[↦]vs'))⟩ ⇒ ⟨e',(h',l'')⟩ ∧
P ⊢ Ts Casts vs to vs' ∧ length vs' = length vs"
proof (induct ps)
case Nil then show ?case by(fastforce intro:Casts_Nil)
next
case (Cons p ps')
have length_eqs: "length (p # ps') = length Ts"
"length (p # ps') = length vs" by fact+
then obtain T Ts' where Ts: "Ts = T#Ts'" by (cases "Ts") simp
obtain v vs' where vs: "vs = v#vs'" using length_eqs by (cases "vs") simp
with length_eqs Ts have length1:"length ps' = length Ts'"
and length2:"length ps' = length vs'" by simp_all
have "P,E ⊢ ⟨⦇C'⦈(blocks (p # ps', Ts, vs, e)),(h,l)⟩ ⇒ ⟨e',(h', l')⟩" by fact
moreover
{ fix a Cs Cs'
assume blocks:"P,E ⊢ ⟨blocks(p#ps',Ts,vs,e),(h,l)⟩ ⇒ ⟨ref (a,Cs),(h',l')⟩"
and path_via:"P ⊢ Path last Cs to C' via Cs'"
and e':"e' = ref(a,Cs@⇩pCs')"
from blocks length_eqs obtain l'' vs''
where eval:"P,E(p#ps' [↦] Ts) ⊢ ⟨e,(h,l(p#ps'[↦]vs''))⟩ ⇒
⟨ref (a,Cs),(h',l'')⟩"
and casts:"P ⊢ Ts Casts vs to vs''"
and length:"length vs'' = length vs"
by -(drule blocksEval,auto)
from eval path_via have
"P,E(p#ps'[↦]Ts) ⊢ ⟨⦇C'⦈e,(h,l(p#ps'[↦]vs''))⟩ ⇒ ⟨ref(a,Cs@⇩pCs'),(h',l'')⟩"
by(auto intro:StaticUpCast)
with e' casts length have ?case by simp blast }
moreover
{ fix a Cs Cs'
assume blocks:"P,E ⊢ ⟨blocks(p#ps',Ts,vs,e),(h,l)⟩ ⇒
⟨ref (a,Cs@C'# Cs'),(h',l')⟩"
and e':"e' = ref (a,Cs@[C'])"
from blocks length_eqs obtain l'' vs''
where eval:"P,E(p#ps' [↦] Ts) ⊢ ⟨e,(h,l(p#ps'[↦]vs''))⟩ ⇒
⟨ref (a,Cs@C'# Cs'),(h',l'')⟩"
and casts:"P ⊢ Ts Casts vs to vs''"
and length:"length vs'' = length vs"
by -(drule blocksEval,auto)
from eval have "P,E(p#ps'[↦]Ts) ⊢ ⟨⦇C'⦈e,(h,l(p#ps'[↦]vs''))⟩ ⇒
⟨ref(a,Cs@[C']),(h',l'')⟩"
by(auto intro:StaticDownCast)
with e' casts length have ?case by simp blast }
moreover
{ assume "P,E ⊢ ⟨blocks(p#ps',Ts,vs,e),(h,l)⟩ ⇒ ⟨null,(h',l')⟩"
and e':"e' = null"
with length_eqs obtain l'' vs''
where eval:"P,E(p#ps' [↦] Ts) ⊢ ⟨e,(h,l(p#ps'[↦]vs''))⟩ ⇒
⟨null,(h',l'')⟩"
and casts:"P ⊢ Ts Casts vs to vs''"
and length:"length vs'' = length vs"
by -(drule blocksEval,auto)
from eval have "P,E(p#ps' [↦] Ts) ⊢ ⟨⦇C'⦈e,(h,l(p#ps'[↦]vs''))⟩ ⇒
⟨null,(h',l'')⟩"
by(auto intro:StaticCastNull)
with e' casts length have ?case by simp blast }
moreover
{ fix a Cs
assume blocks:"P,E ⊢ ⟨blocks(p#ps',Ts,vs,e),(h,l)⟩ ⇒ ⟨ref (a,Cs),(h',l')⟩"
and notin:"C' ∉ set Cs" and leq:"¬ P ⊢ (last Cs) ≼⇧* C'"
and e':"e' = THROW ClassCast"
from blocks length_eqs obtain l'' vs''
where eval:"P,E(p#ps' [↦] Ts) ⊢ ⟨e,(h,l(p#ps'[↦]vs''))⟩ ⇒
⟨ref (a,Cs),(h',l'')⟩"
and casts:"P ⊢ Ts Casts vs to vs''"
and length:"length vs'' = length vs"
by -(drule blocksEval,auto)
from eval notin leq have
"P,E(p#ps'[↦]Ts) ⊢ ⟨⦇C'⦈e,(h,l(p#ps'[↦]vs''))⟩ ⇒
⟨THROW ClassCast,(h',l'')⟩"
by(auto intro:StaticCastFail)
with e' casts length have ?case by simp blast }
moreover
{ fix r assume "P,E ⊢ ⟨blocks(p#ps',Ts,vs,e),(h,l)⟩ ⇒ ⟨throw r,(h',l')⟩"
and e':"e' = throw r"
with length_eqs obtain l'' vs''
where eval:"P,E(p#ps' [↦] Ts) ⊢ ⟨e,(h,l(p#ps'[↦]vs''))⟩ ⇒
⟨throw r,(h',l'')⟩"
and casts:"P ⊢ Ts Casts vs to vs''"
and length:"length vs'' = length vs"
by -(drule blocksEval,auto)
from eval have
"P,E(p#ps'[↦]Ts) ⊢ ⟨⦇C'⦈e,(h,l(p#ps'[↦]vs''))⟩ ⇒
⟨throw r,(h',l'')⟩"
by(auto intro:eval_evals.StaticCastThrow)
with e' casts length have ?case by simp blast }
ultimately show ?case
by -(erule eval_cases,fastforce+)
qed
lemma
assumes wf: "wwf_prog P"
shows eval_restrict_lcl:
"P,E ⊢ ⟨e,(h,l)⟩ ⇒ ⟨e',(h',l')⟩ ⟹ (⋀W. fv e ⊆ W ⟹ P,E ⊢ ⟨e,(h,l|`W)⟩ ⇒ ⟨e',(h',l'|`W)⟩)"
and "P,E ⊢ ⟨es,(h,l)⟩ [⇒] ⟨es',(h',l')⟩ ⟹ (⋀W. fvs es ⊆ W ⟹ P,E ⊢ ⟨es,(h,l|`W)⟩ [⇒] ⟨es',(h',l'|`W)⟩)"
proof(induct rule:eval_evals_inducts)
case (Block E V T e⇩0 h⇩0 l⇩0 e⇩1 h⇩1 l⇩1)
have IH: "⋀W. fv e⇩0 ⊆ W ⟹
P,E(V ↦ T) ⊢ ⟨e⇩0,(h⇩0,l⇩0(V:=None)|`W)⟩ ⇒ ⟨e⇩1,(h⇩1,l⇩1|`W)⟩" by fact
have "fv({V:T; e⇩0}) ⊆ W" by fact
hence "fv e⇩0 - {V} ⊆ W" by simp_all
hence "fv e⇩0 ⊆ insert V W" by fast
with IH[OF this]
have "P,E(V ↦ T) ⊢ ⟨e⇩0,(h⇩0, (l⇩0|`W)(V := None))⟩ ⇒ ⟨e⇩1,(h⇩1, l⇩1|`insert V W)⟩"
by fastforce
from eval_evals.Block[OF this] show ?case by fastforce
next
case Seq thus ?case by simp (blast intro:eval_evals.Seq)
next
case New thus ?case by(simp add:eval_evals.intros)
next
case NewFail thus ?case by(simp add:eval_evals.intros)
next
case StaticUpCast thus ?case by simp (blast intro:eval_evals.StaticUpCast)
next
case (StaticDownCast E e h l a Cs C Cs' h' l')
have IH:"⋀W. fv e ⊆ W ⟹
P,E ⊢ ⟨e,(h,l |` W)⟩ ⇒ ⟨ref(a,Cs@[C]@Cs'),(h',l' |` W)⟩" by fact
have "fv (⦇C⦈e) ⊆ W" by fact
hence "fv e ⊆ W" by simp
from IH[OF this] show ?case by(rule eval_evals.StaticDownCast)
next
case StaticCastNull thus ?case by simp (blast intro:eval_evals.StaticCastNull)
next
case StaticCastFail thus ?case by simp (blast intro:eval_evals.StaticCastFail)
next
case StaticCastThrow thus ?case by(simp add:eval_evals.intros)
next
case DynCast thus ?case by simp (blast intro:eval_evals.DynCast)
next
case StaticUpDynCast thus ?case by simp (blast intro:eval_evals.StaticUpDynCast)
next
case (StaticDownDynCast E e h l a Cs C Cs' h' l')
have IH:"⋀W. fv e ⊆ W ⟹
P,E ⊢ ⟨e,(h,l |` W)⟩ ⇒ ⟨ref(a,Cs@[C]@Cs'),(h',l' |` W)⟩" by fact
have "fv (Cast C e) ⊆ W" by fact
hence "fv e ⊆ W" by simp
from IH[OF this] show ?case by(rule eval_evals.StaticDownDynCast)
next
case DynCastNull thus ?case by simp (blast intro:eval_evals.DynCastNull)
next
case DynCastFail thus ?case by simp (blast intro:eval_evals.DynCastFail)
next
case DynCastThrow thus ?case by(simp add:eval_evals.intros)
next
case Val thus ?case by(simp add:eval_evals.intros)
next
case BinOp thus ?case by simp (blast intro:eval_evals.BinOp)
next
case BinOpThrow1 thus ?case by simp (blast intro:eval_evals.BinOpThrow1)
next
case BinOpThrow2 thus ?case by simp (blast intro:eval_evals.BinOpThrow2)
next
case Var thus ?case by(simp add:eval_evals.intros)
next
case (LAss E e h⇩0 l⇩0 v h l V T v' l')
have IH: "⋀W. fv e ⊆ W ⟹ P,E ⊢ ⟨e,(h⇩0,l⇩0|`W)⟩ ⇒ ⟨Val v,(h,l|`W)⟩"
and env:"E V = ⌊T⌋" and casts:"P ⊢ T casts v to v'"
and [simp]: "l' = l(V ↦ v')" by fact+
have "fv (V:=e) ⊆ W" by fact
hence fv: "fv e ⊆ W" and VinW: "V ∈ W" by auto
from eval_evals.LAss[OF IH[OF fv] _ casts] env VinW
show ?case by fastforce
next
case LAssThrow thus ?case by(fastforce intro: eval_evals.LAssThrow)
next
case FAcc thus ?case by simp (blast intro: eval_evals.FAcc)
next
case FAccNull thus ?case by(fastforce intro: eval_evals.FAccNull)
next
case FAccThrow thus ?case by(fastforce intro: eval_evals.FAccThrow)
next
case (FAss E e⇩1 h l a Cs' h' l' e⇩2 v h⇩2 l⇩2 D S F T Cs v' Ds fs fs' S' h⇩2' W)
have IH1: "⋀W. fv e⇩1 ⊆ W ⟹ P,E ⊢ ⟨e⇩1,(h, l|`W)⟩ ⇒ ⟨ref (a, Cs'),(h', l'|`W)⟩"
and IH2: "⋀W. fv e⇩2 ⊆ W ⟹ P,E ⊢ ⟨e⇩2,(h', l'|`W)⟩ ⇒ ⟨Val v,(h⇩2, l⇩2|`W)⟩"
and fv:"fv (e⇩1∙F{Cs} := e⇩2) ⊆ W"
and h:"h⇩2 a = Some(D,S)" and Ds:"Ds = Cs' @⇩p Cs"
and S:"(Ds,fs) ∈ S" and fs':"fs' = fs(F ↦ v')"
and S':"S' = S - {(Ds, fs)} ∪ {(Ds, fs')}"
and h':"h⇩2' = h⇩2(a ↦ (D, S'))"
and field:"P ⊢ last Cs' has least F:T via Cs"
and casts:"P ⊢ T casts v to v'" by fact+
from fv have fv1:"fv e⇩1 ⊆ W" and fv2:"fv e⇩2 ⊆ W" by auto
from eval_evals.FAss[OF IH1[OF fv1] IH2[OF fv2] _ field casts] h Ds S fs' S' h'
show ?case by simp
next
case FAssNull thus ?case by simp (blast intro: eval_evals.FAssNull)
next
case FAssThrow1 thus ?case by simp (blast intro: eval_evals.FAssThrow1)
next
case FAssThrow2 thus ?case by simp (blast intro: eval_evals.FAssThrow2)
next
case CallObjThrow thus ?case by simp (blast intro: eval_evals.intros)
next
case CallNull thus ?case by simp (blast intro: eval_evals.CallNull)
next
case CallParamsThrow thus ?case
by simp (blast intro: eval_evals.CallParamsThrow)
next
case (Call E e h⇩0 l⇩0 a Cs h⇩1 l⇩1 ps vs h⇩2 l⇩2 C S M Ts' T' pns'
body' Ds Ts T pns body Cs' vs' l⇩2' new_body e' h⇩3 l⇩3 W)
have IHe: "⋀W. fv e ⊆ W ⟹ P,E ⊢ ⟨e,(h⇩0,l⇩0|`W)⟩ ⇒ ⟨ref(a,Cs),(h⇩1,l⇩1|`W)⟩"
and IHps: "⋀W. fvs ps ⊆ W ⟹ P,E ⊢ ⟨ps,(h⇩1,l⇩1|`W)⟩ [⇒] ⟨map Val vs,(h⇩2,l⇩2|`W)⟩"
and IHbd: "⋀W. fv new_body ⊆ W ⟹ P,E(this ↦ Class (last Cs'), pns [↦] Ts) ⊢
⟨new_body,(h⇩2,l⇩2'|`W)⟩ ⇒ ⟨e',(h⇩3,l⇩3|`W)⟩"
and h⇩2a: "h⇩2 a = Some (C,S)"
and "method": "P ⊢ last Cs has least M = (Ts',T',pns',body') via Ds"
and select:"P ⊢ (C,Cs@⇩pDs) selects M = (Ts,T,pns,body) via Cs'"
and same_len: "size vs = size pns"
and casts:"P ⊢ Ts Casts vs to vs'"
and l⇩2': "l⇩2' = [this ↦ Ref(a,Cs'), pns [↦] vs']"
and body_case: "new_body = (case T' of Class D ⇒ ⦇D⦈body | _ ⇒ body)" by fact+
have "fv (e∙M(ps)) ⊆ W" by fact
hence fve: "fv e ⊆ W" and fvps: "fvs(ps) ⊆ W" by auto
have wfmethod: "size Ts = size pns ∧ this ∉ set pns" and
fvbd: "fv body ⊆ {this} ∪ set pns"
using select wf by(fastforce dest!:select_method_wf_mdecl simp:wf_mdecl_def)+
from fvbd body_case have fvbd':"fv new_body ⊆ {this} ∪ set pns"
by(cases T') auto
from l⇩2' have "l⇩2' |` ({this} ∪ set pns) = [this ↦ Ref (a, Cs'), pns [↦] vs']"
by (auto intro!:ext simp:restrict_map_def fun_upd_def)
with eval_evals.Call[OF IHe[OF fve] IHps[OF fvps] _ "method" select same_len
casts _ body_case IHbd[OF fvbd']] h⇩2a
show ?case by simp
next
case (StaticCall E e h⇩0 l⇩0 a Cs h⇩1 l⇩1 ps vs h⇩2 l⇩2 C Cs'' M Ts T pns body
Cs' Ds vs' l⇩2' e' h⇩3 l⇩3 W)
have IHe: "⋀W. fv e ⊆ W ⟹ P,E ⊢ ⟨e,(h⇩0,l⇩0|`W)⟩ ⇒ ⟨ref(a,Cs),(h⇩1,l⇩1|`W)⟩"
and IHps: "⋀W. fvs ps ⊆ W ⟹ P,E ⊢ ⟨ps,(h⇩1,l⇩1|`W)⟩ [⇒] ⟨map Val vs,(h⇩2,l⇩2|`W)⟩"
and IHbd: "⋀W. fv body ⊆ W ⟹ P,E(this ↦ Class (last Ds), pns [↦] Ts) ⊢
⟨body,(h⇩2,l⇩2'|`W)⟩ ⇒ ⟨e',(h⇩3,l⇩3|`W)⟩"
and path_unique: "P ⊢ Path last Cs to C unique"
and path_via: "P ⊢ Path last Cs to C via Cs''"
and least: "P ⊢ C has least M = (Ts, T, pns, body) via Cs'"
and Ds: "Ds = (Cs @⇩p Cs'') @⇩p Cs'"
and same_len: "size vs = size pns"
and casts:"P ⊢ Ts Casts vs to vs'"
and l⇩2': "l⇩2' = [this ↦ Ref(a,Ds), pns [↦] vs']" by fact+
have "fv (e∙(C::)M(ps)) ⊆ W" by fact
hence fve: "fv e ⊆ W" and fvps: "fvs(ps) ⊆ W" by auto
have wfmethod: "size Ts = size pns ∧ this ∉ set pns" and
fvbd: "fv body ⊆ {this} ∪ set pns"
using least wf by(fastforce dest!:has_least_wf_mdecl simp:wf_mdecl_def)+
from fvbd have fvbd':"fv body ⊆ {this} ∪ set pns"
by auto
from l⇩2' have "l⇩2' |` ({this} ∪ set pns) = [this ↦ Ref(a,Ds), pns [↦] vs']"
by (auto intro!:ext simp:restrict_map_def fun_upd_def)
with eval_evals.StaticCall[OF IHe[OF fve] IHps[OF fvps] path_unique path_via
least Ds same_len casts _ IHbd[OF fvbd']]
show ?case by simp
next
case SeqThrow thus ?case by simp (blast intro: eval_evals.SeqThrow)
next
case CondT thus ?case by simp (blast intro: eval_evals.CondT)
next
case CondF thus ?case by simp (blast intro: eval_evals.CondF)
next
case CondThrow thus ?case by simp (blast intro: eval_evals.CondThrow)
next
case WhileF thus ?case by simp (blast intro: eval_evals.WhileF)
next
case WhileT thus ?case by simp (blast intro: eval_evals.WhileT)
next
case WhileCondThrow thus ?case by simp (blast intro: eval_evals.WhileCondThrow)
next
case WhileBodyThrow thus ?case by simp (blast intro: eval_evals.WhileBodyThrow)
next
case Throw thus ?case by simp (blast intro: eval_evals.Throw)
next
case ThrowNull thus ?case by simp (blast intro: eval_evals.ThrowNull)
next
case ThrowThrow thus ?case by simp (blast intro: eval_evals.ThrowThrow)
next
case Nil thus ?case by (simp add: eval_evals.Nil)
next
case Cons thus ?case by simp (blast intro: eval_evals.Cons)
next
case ConsThrow thus ?case by simp (blast intro: eval_evals.ConsThrow)
qed
lemma eval_notfree_unchanged:
assumes wf:"wwf_prog P"
shows "P,E ⊢ ⟨e,(h,l)⟩ ⇒ ⟨e',(h',l')⟩ ⟹ (⋀V. V ∉ fv e ⟹ l' V = l V)"
and "P,E ⊢ ⟨es,(h,l)⟩ [⇒] ⟨es',(h',l')⟩ ⟹ (⋀V. V ∉ fvs es ⟹ l' V = l V)"
proof(induct rule:eval_evals_inducts)
case LAss thus ?case by(simp add:fun_upd_apply)
next
case Block thus ?case
by (simp only:fun_upd_apply split:if_splits) fastforce
qed simp_all
lemma eval_closed_lcl_unchanged:
assumes wf:"wwf_prog P"
and eval:"P,E ⊢ ⟨e,(h,l)⟩ ⇒ ⟨e',(h',l')⟩"
and fv:"fv e = {}"
shows "l' = l"
proof -
from wf eval have "⋀V. V ∉ fv e ⟹ l' V = l V" by (rule eval_notfree_unchanged)
with fv have "⋀V. l' V = l V" by simp
thus ?thesis by(simp add:fun_eq_iff)
qed
declare split_paired_All [simp del] split_paired_Ex [simp del]
declaration ‹K (Simplifier.map_ss (fn ss => ss delloop "split_all_tac"))›
setup ‹map_theory_claset (fn ctxt => ctxt delSWrapper "split_all_tac")›
lemma list_eval_Throw:
assumes eval_e: "P,E ⊢ ⟨throw x,s⟩ ⇒ ⟨e',s'⟩"
shows "P,E ⊢ ⟨map Val vs @ throw x # es',s⟩ [⇒] ⟨map Val vs @ e' # es',s'⟩"
proof -
from eval_e
obtain a where e': "e' = Throw a"
by (cases) (auto dest!: eval_final)
{
fix es
have "⋀vs. es = map Val vs @ throw x # es'
⟹ P,E ⊢ ⟨es,s⟩[⇒]⟨map Val vs @ e' # es',s'⟩"
proof (induct es type: list)
case Nil thus ?case by simp
next
case (Cons e es vs)
have e_es: "e # es = map Val vs @ throw x # es'" by fact
show "P,E ⊢ ⟨e # es,s⟩ [⇒] ⟨map Val vs @ e' # es',s'⟩"
proof (cases vs)
case Nil
with e_es obtain "e=throw x" "es=es'" by simp
moreover from eval_e e'
have "P,E ⊢ ⟨throw x # es,s⟩ [⇒] ⟨Throw a # es,s'⟩"
by (iprover intro: ConsThrow)
ultimately show ?thesis using Nil e' by simp
next
case (Cons v vs')
have vs: "vs = v # vs'" by fact
with e_es obtain
e: "e=Val v" and es:"es= map Val vs' @ throw x # es'"
by simp
from e
have "P,E ⊢ ⟨e,s⟩ ⇒ ⟨Val v,s⟩"
by (iprover intro: eval_evals.Val)
moreover from es
have "P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val vs' @ e' # es',s'⟩"
by (rule Cons.hyps)
ultimately show
"P,E ⊢ ⟨e#es,s⟩ [⇒] ⟨map Val vs @ e' # es',s'⟩"
using vs by (auto intro: eval_evals.Cons)
qed
qed
}
thus ?thesis
by simp
qed
text ‹The key lemma:›
lemma
assumes wf: "wwf_prog P"
shows extend_1_eval:
"P,E ⊢ ⟨e,s⟩ → ⟨e'',s''⟩ ⟹ (⋀s' e'. P,E ⊢ ⟨e'',s''⟩ ⇒ ⟨e',s'⟩ ⟹ P,E ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩)"
and extend_1_evals:
"P,E ⊢ ⟨es,t⟩ [→] ⟨es'',t''⟩ ⟹ (⋀t' es'. P,E ⊢ ⟨es'',t''⟩ [⇒] ⟨es',t'⟩ ⟹ P,E ⊢ ⟨es,t⟩ [⇒] ⟨es',t'⟩)"
proof (induct rule: red_reds.inducts)
case RedNew thus ?case by (iprover elim: eval_cases intro: eval_evals.intros)
next
case RedNewFail thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case (StaticCastRed E e s e'' s'' C s' e') thus ?case
by -(erule eval_cases,auto intro:eval_evals.intros,
subgoal_tac "P,E ⊢ ⟨e'',s''⟩ ⇒ ⟨ref(a,Cs@[C]@Cs'),s'⟩",
rule_tac Cs'="Cs'" in StaticDownCast,auto)
next
case RedStaticCastNull thus ?case
by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case RedStaticUpCast thus ?case
by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case RedStaticDownCast thus ?case
by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case RedStaticCastFail thus ?case
by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case RedStaticUpDynCast thus ?case
by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case RedStaticDownDynCast thus ?case
by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case (DynCastRed E e s e'' s'' C s' e')
have eval:"P,E ⊢ ⟨Cast C e'',s''⟩ ⇒ ⟨e',s'⟩"
and IH:"⋀ex sx. P,E ⊢ ⟨e'',s''⟩ ⇒ ⟨ex,sx⟩ ⟹ P,E ⊢ ⟨e,s⟩ ⇒ ⟨ex,sx⟩" by fact+
moreover
{ fix Cs Cs' a
assume "P,E ⊢ ⟨e'',s''⟩ ⇒ ⟨ref (a, Cs @ C # Cs'),s'⟩"
from IH[OF this] have "P,E ⊢ ⟨e,s⟩ ⇒ ⟨ref (a, Cs@[C]@Cs'),s'⟩" by simp
hence "P,E ⊢ ⟨Cast C e,s⟩ ⇒ ⟨ref (a, Cs@[C]),s'⟩" by(rule StaticDownDynCast) }
ultimately show ?case by -(erule eval_cases,auto intro: eval_evals.intros)
next
case RedDynCastNull thus ?case by (iprover elim:eval_cases intro:eval_evals.intros)
next
case (RedDynCast s a D S C Cs' E Cs s' e')
thus ?case by (cases s)(auto elim!:eval_cases intro:eval_evals.intros)
next
case (RedDynCastFail s a D S C Cs E s'' e'')
thus ?case by (cases s)(auto elim!: eval_cases intro: eval_evals.intros)
next
case BinOpRed1 thus ?case by -(erule eval_cases,auto intro: eval_evals.intros)
next
case BinOpRed2
thus ?case by (fastforce elim!:eval_cases intro:eval_evals.intros eval_finalId)
next
case RedBinOp thus ?case by (iprover elim:eval_cases intro:eval_evals.intros)
next
case (RedVar s V v E s' e')
thus ?case by (cases s)(fastforce elim:eval_cases intro:eval_evals.intros)
next
case LAssRed thus ?case by -(erule eval_cases,auto intro:eval_evals.intros)
next
case RedLAss
thus ?case by (fastforce elim:eval_cases intro:eval_evals.intros)
next
case FAccRed thus ?case by -(erule eval_cases,auto intro:eval_evals.intros)
next
case (RedFAcc s a D S Ds Cs' Cs fs F v E s' e')
thus ?case by (cases s)(fastforce elim:eval_cases intro:eval_evals.intros)
next
case RedFAccNull thus ?case by (fastforce elim!:eval_cases intro:eval_evals.intros)
next
case (FAssRed1 E e⇩1 s e⇩1' s'' F Cs e⇩2 s' e')
have eval:"P,E ⊢ ⟨e⇩1'∙F{Cs} := e⇩2,s''⟩ ⇒ ⟨e',s'⟩"
and IH:"⋀ex sx. P,E ⊢ ⟨e⇩1',s''⟩ ⇒ ⟨ex,sx⟩ ⟹ P,E ⊢ ⟨e⇩1,s⟩ ⇒ ⟨ex,sx⟩" by fact+
{ fix Cs' D S T a fs h⇩2 l⇩2 s⇩1 v v'
assume ref:"P,E ⊢ ⟨e⇩1',s''⟩ ⇒ ⟨ref (a, Cs'),s⇩1⟩"
and rest:"P,E ⊢ ⟨e⇩2,s⇩1⟩ ⇒ ⟨Val v,(h⇩2, l⇩2)⟩" "h⇩2 a = ⌊(D, S)⌋"
"P ⊢ last Cs' has least F:T via Cs" "P ⊢ T casts v to v'"
"(Cs' @⇩p Cs, fs) ∈ S"
from IH[OF ref] have "P,E ⊢ ⟨e⇩1,s⟩ ⇒ ⟨ref (a, Cs'),s⇩1⟩" .
with rest have "P,E ⊢ ⟨e⇩1∙F{Cs} := e⇩2,s⟩ ⇒
⟨Val v',(h⇩2(a ↦ (D,insert (Cs'@⇩pCs,fs(F ↦ v'))(S - {(Cs'@⇩pCs,fs)}))),l⇩2)⟩"
by-(rule FAss,simp_all) }
moreover
{ fix s⇩1 v
assume null:"P,E ⊢ ⟨e⇩1',s''⟩ ⇒ ⟨null,s⇩1⟩"
and rest:"P,E ⊢ ⟨e⇩2,s⇩1⟩ ⇒ ⟨Val v,s'⟩"
from IH[OF null] have "P,E ⊢ ⟨e⇩1,s⟩ ⇒ ⟨null,s⇩1⟩" .
with rest have "P,E ⊢ ⟨e⇩1∙F{Cs} := e⇩2,s⟩ ⇒ ⟨THROW NullPointer,s'⟩"
by-(rule FAssNull,simp_all) }
moreover
{ fix e' assume throw:"P,E ⊢ ⟨e⇩1',s''⟩ ⇒ ⟨throw e',s'⟩"
from IH[OF throw] have "P,E ⊢ ⟨e⇩1,s⟩ ⇒ ⟨throw e',s'⟩" .
hence "P,E ⊢ ⟨e⇩1∙F{Cs} := e⇩2,s⟩ ⇒ ⟨throw e',s'⟩"
by-(rule eval_evals.FAssThrow1,simp_all) }
moreover
{ fix e' s⇩1 v
assume val:"P,E ⊢ ⟨e⇩1',s''⟩ ⇒ ⟨Val v,s⇩1⟩"
and rest:"P,E ⊢ ⟨e⇩2,s⇩1⟩ ⇒ ⟨throw e',s'⟩"
from IH[OF val] have "P,E ⊢ ⟨e⇩1,s⟩ ⇒ ⟨Val v,s⇩1⟩" .
with rest have "P,E ⊢ ⟨e⇩1∙F{Cs} := e⇩2,s⟩ ⇒ ⟨throw e',s'⟩"
by-(rule eval_evals.FAssThrow2,simp_all) }
ultimately show ?case using eval
by -(erule eval_cases,auto)
next
case (FAssRed2 E e⇩2 s e⇩2' s'' v F Cs s' e')
have eval:"P,E ⊢ ⟨Val v∙F{Cs} := e⇩2',s''⟩ ⇒ ⟨e',s'⟩"
and IH:"⋀ex sx. P,E ⊢ ⟨e⇩2',s''⟩ ⇒ ⟨ex,sx⟩ ⟹ P,E ⊢ ⟨e⇩2,s⟩ ⇒ ⟨ex,sx⟩" by fact+
{ fix Cs' D S T a fs h⇩2 l⇩2 s⇩1 v' v''
assume val1:"P,E ⊢ ⟨Val v,s''⟩ ⇒ ⟨ref (a,Cs'),s⇩1⟩"
and val2:"P,E ⊢ ⟨e⇩2',s⇩1⟩ ⇒ ⟨Val v',(h⇩2, l⇩2)⟩"
and rest:"h⇩2 a = ⌊(D, S)⌋" "P ⊢ last Cs' has least F:T via Cs"
"P ⊢ T casts v' to v''" "(Cs'@⇩pCs,fs) ∈ S"
from val1 have s'':"s⇩1 = s''" by -(erule eval_cases)
with val1 have "P,E ⊢ ⟨Val v,s⟩ ⇒ ⟨ref (a,Cs'),s⟩"
by(fastforce elim:eval_cases intro:eval_finalId)
also from IH[OF val2[simplified s'']] have "P,E ⊢ ⟨e⇩2,s⟩ ⇒ ⟨Val v',(h⇩2, l⇩2)⟩" .
ultimately have "P,E ⊢ ⟨Val v∙F{Cs} := e⇩2,s⟩ ⇒
⟨Val v'',(h⇩2(a↦(D,insert(Cs'@⇩pCs,fs(F ↦ v''))(S - {(Cs'@⇩pCs,fs)}))),l⇩2)⟩"
using rest by -(rule FAss,simp_all) }
moreover
{ fix s⇩1 v'
assume val1:"P,E ⊢ ⟨Val v,s''⟩ ⇒ ⟨null,s⇩1⟩"
and val2:"P,E ⊢ ⟨e⇩2',s⇩1⟩ ⇒ ⟨Val v',s'⟩"
from val1 have s'':"s⇩1 = s''" by -(erule eval_cases)
with val1 have "P,E ⊢ ⟨Val v,s⟩ ⇒ ⟨null,s⟩"
by(fastforce elim:eval_cases intro:eval_finalId)
also from IH[OF val2[simplified s'']] have "P,E ⊢ ⟨e⇩2,s⟩ ⇒ ⟨Val v',s'⟩" .
ultimately have "P,E ⊢ ⟨Val v∙F{Cs} := e⇩2,s⟩ ⇒ ⟨THROW NullPointer,s'⟩"
by -(rule FAssNull,simp_all) }
moreover
{ fix r assume val:"P,E ⊢ ⟨Val v,s''⟩ ⇒ ⟨throw r,s'⟩"
hence s'':"s'' = s'" by -(erule eval_cases,simp)
with val have "P,E ⊢ ⟨Val v∙F{Cs} := e⇩2,s⟩ ⇒ ⟨throw r,s'⟩"
by -(rule eval_evals.FAssThrow1,erule eval_cases,simp) }
moreover
{ fix r s⇩1 v'
assume val1:"P,E ⊢ ⟨Val v,s''⟩ ⇒ ⟨Val v',s⇩1⟩"
and val2:"P,E ⊢ ⟨e⇩2',s⇩1⟩ ⇒ ⟨throw r,s'⟩"
from val1 have s'':"s⇩1 = s''" by -(erule eval_cases)
with val1 have "P,E ⊢ ⟨Val v,s⟩ ⇒ ⟨Val v',s⟩"
by(fastforce elim:eval_cases intro:eval_finalId)
also from IH[OF val2[simplified s'']] have "P,E ⊢ ⟨e⇩2,s⟩ ⇒ ⟨throw r,s'⟩" .
ultimately have "P,E ⊢ ⟨Val v∙F{Cs} := e⇩2,s⟩ ⇒ ⟨throw r,s'⟩"
by -(rule eval_evals.FAssThrow2,simp_all) }
ultimately show ?case using eval
by -(erule eval_cases,auto)
next
case (RedFAss h a D S Cs' F T Cs v v' Ds fs E l s' e')
have val:"P,E ⊢ ⟨Val v',(h(a ↦ (D,insert (Ds,fs(F ↦ v'))(S - {(Ds,fs)}))),l)⟩ ⇒
⟨e',s'⟩"
and rest:"h a = ⌊(D, S)⌋" "P ⊢ last Cs' has least F:T via Cs"
"P ⊢ T casts v to v'" "Ds = Cs' @⇩p Cs" "(Ds, fs) ∈ S" by fact+
from val have "s' = (h(a ↦ (D,insert (Ds,fs(F ↦ v')) (S - {(Ds,fs)}))),l)"
and "e' = Val v'" by -(erule eval_cases,simp_all)+
with rest show ?case apply simp
by(rule FAss,simp_all)(rule eval_finalId,simp)+
next
case RedFAssNull
thus ?case by (fastforce elim!: eval_cases intro: eval_evals.intros)
next
case (CallObj E e s e' s' Copt M es s'' e'')
thus ?case
apply -
apply(cases Copt,simp)
by(erule eval_cases,auto intro:eval_evals.intros)+
next
case (CallParams E es s es' s'' v Copt M s' e')
have call:"P,E ⊢ ⟨Call (Val v) Copt M es',s''⟩ ⇒ ⟨e',s'⟩"
and IH:"⋀esx sx. P,E ⊢ ⟨es',s''⟩ [⇒] ⟨esx,sx⟩ ⟹ P,E ⊢ ⟨es,s⟩ [⇒] ⟨esx,sx⟩" by fact+
show ?case
proof(cases Copt)
case None with call have eval:"P,E ⊢ ⟨Val v∙M(es'),s''⟩ ⇒ ⟨e',s'⟩" by simp
from eval show ?thesis
proof(rule eval_cases)
fix r assume "P,E ⊢ ⟨Val v,s''⟩ ⇒ ⟨throw r,s'⟩" "e' = throw r"
with None show "P,E ⊢ ⟨Call (Val v) Copt M es,s⟩ ⇒ ⟨e',s'⟩"
by(fastforce elim:eval_cases)
next
fix es'' r sx v' vs
assume val:"P,E ⊢ ⟨Val v,s''⟩ ⇒ ⟨Val v',sx⟩"
and evals:"P,E ⊢ ⟨es',sx⟩ [⇒] ⟨map Val vs @ throw r # es'',s'⟩"
and e':"e' = throw r"
have val':"P,E ⊢ ⟨Val v,s⟩ ⇒ ⟨Val v,s⟩" by(rule Val)
from val have eq:"v' = v ∧ s'' = sx" by -(erule eval_cases,simp)
with IH evals have "P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val vs @ throw r # es'',s'⟩"
by simp
with eq CallParamsThrow[OF val'] e' None
show "P,E ⊢ ⟨Call (Val v) Copt M es,s⟩ ⇒ ⟨e',s'⟩"
by fastforce
next
fix C Cs Cs' Ds S T T' Ts Ts' a body body' h⇩2 h⇩3 l⇩2 l⇩3 pns pns' s⇩1 vs vs'
assume val:"P,E ⊢ ⟨Val v,s''⟩ ⇒ ⟨ref(a,Cs),s⇩1⟩"
and evals:"P,E ⊢ ⟨es',s⇩1⟩ [⇒] ⟨map Val vs,(h⇩2,l⇩2)⟩"
and hp:"h⇩2 a = Some(C, S)"
and "method":"P ⊢ last Cs has least M = (Ts',T',pns',body') via Ds"
and select:"P ⊢ (C,Cs@⇩pDs) selects M = (Ts,T,pns,body) via Cs'"
and length:"length vs = length pns"
and casts:"P ⊢ Ts Casts vs to vs'"
and body:"P,E(this ↦ Class (last Cs'), pns [↦] Ts) ⊢
⟨case T' of Class D ⇒ ⦇D⦈body | _ ⇒ body,(h⇩2,[this ↦ Ref(a,Cs'),pns [↦] vs'])⟩
⇒ ⟨e',(h⇩3, l⇩3)⟩"
and s':"s' = (h⇩3, l⇩2)"
from val have val':"P,E ⊢ ⟨Val v,s⟩ ⇒ ⟨ref(a,Cs),s⟩"
and eq:"s'' = s⇩1 ∧ v = Ref(a,Cs)"
by(auto elim:eval_cases intro:Val)
from body obtain new_body
where body_case:"new_body = (case T' of Class D ⇒ ⦇D⦈body | _ ⇒ body)"
and body':"P,E(this ↦ Class (last Cs'), pns [↦] Ts) ⊢
⟨new_body,(h⇩2,[this ↦ Ref(a,Cs'),pns [↦] vs'])⟩ ⇒ ⟨e',(h⇩3, l⇩3)⟩"
by simp
from eq IH evals have "P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val vs,(h⇩2,l⇩2)⟩" by simp
with eq Call[OF val' _ _ "method" select length casts _ body_case]
hp body' s' None
show "P,E ⊢ ⟨Call (Val v) Copt M es,s⟩ ⇒ ⟨e',s'⟩" by fastforce
next
fix s⇩1 vs
assume val:"P,E ⊢ ⟨Val v,s''⟩ ⇒ ⟨null,s⇩1⟩"
and evals:"P,E ⊢ ⟨es',s⇩1⟩ [⇒] ⟨map Val vs,s'⟩"
and e':"e' = THROW NullPointer"
from val have val':"P,E ⊢ ⟨Val v,s⟩ ⇒ ⟨null,s⟩"
and eq:"s'' = s⇩1 ∧ v = Null"
by(auto elim:eval_cases intro:Val)
from eq IH evals have "P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val vs,s'⟩" by simp
with eq CallNull[OF val'] e' None
show "P,E ⊢ ⟨Call (Val v) Copt M es,s⟩ ⇒ ⟨e',s'⟩" by fastforce
qed
next
case (Some C) with call have eval:"P,E ⊢ ⟨Val v∙(C::)M(es'),s''⟩ ⇒ ⟨e',s'⟩"
by simp
from eval show ?thesis
proof(rule eval_cases)
fix r assume "P,E ⊢ ⟨Val v,s''⟩ ⇒ ⟨throw r,s'⟩" "e' = throw r"
with Some show "P,E ⊢ ⟨Call (Val v) Copt M es,s⟩ ⇒ ⟨e',s'⟩"
by(fastforce elim:eval_cases)
next
fix es'' r sx v' vs
assume val:"P,E ⊢ ⟨Val v,s''⟩ ⇒ ⟨Val v',sx⟩"
and evals:"P,E ⊢ ⟨es',sx⟩ [⇒] ⟨map Val vs @ throw r # es'',s'⟩"
and e':"e' = throw r"
have val':"P,E ⊢ ⟨Val v,s⟩ ⇒ ⟨Val v,s⟩" by(rule Val)
from val have eq:"v' = v ∧ s'' = sx" by -(erule eval_cases,simp)
with IH evals have "P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val vs @ throw r # es'',s'⟩"
by simp
with eq CallParamsThrow[OF val'] e' Some
show "P,E ⊢ ⟨Call (Val v) Copt M es,s⟩ ⇒ ⟨e',s'⟩"
by fastforce
next
fix Cs Cs' Cs'' T Ts a body h⇩2 h⇩3 l⇩2 l⇩3 pns s⇩1 vs vs'
assume val:"P,E ⊢ ⟨Val v,s''⟩ ⇒ ⟨ref (a,Cs),s⇩1⟩"
and evals:"P,E ⊢ ⟨es',s⇩1⟩ [⇒] ⟨map Val vs,(h⇩2,l⇩2)⟩"
and path_unique:"P ⊢ Path last Cs to C unique"
and path_via:"P ⊢ Path last Cs to C via Cs''"
and least:"P ⊢ C has least M = (Ts, T, pns, body) via Cs'"
and length:"length vs = length pns"
and casts:"P ⊢ Ts Casts vs to vs'"
and body:"P,E(this ↦ Class (last ((Cs @⇩p Cs'') @⇩p Cs')), pns [↦] Ts) ⊢
⟨body,(h⇩2,[this ↦ Ref(a,(Cs@⇩pCs'')@⇩pCs'),pns [↦] vs'])⟩ ⇒ ⟨e',(h⇩3,l⇩3)⟩"
and s':"s' = (h⇩3,l⇩2)"
from val have val':"P,E ⊢ ⟨Val v,s⟩ ⇒ ⟨ref(a,Cs),s⟩"
and eq:"s'' = s⇩1 ∧ v = Ref(a,Cs)"
by(auto elim:eval_cases intro:Val)
from eq IH evals have "P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val vs,(h⇩2,l⇩2)⟩" by simp
with eq StaticCall[OF val' _ path_unique path_via least _ _ casts _ body]
length s' Some
show "P,E ⊢ ⟨Call (Val v) Copt M es,s⟩ ⇒ ⟨e',s'⟩" by fastforce
next
fix s⇩1 vs
assume val:"P,E ⊢ ⟨Val v,s''⟩ ⇒ ⟨null,s⇩1⟩"
and evals:"P,E ⊢ ⟨es',s⇩1⟩ [⇒] ⟨map Val vs,s'⟩"
and e':"e' = THROW NullPointer"
from val have val':"P,E ⊢ ⟨Val v,s⟩ ⇒ ⟨null,s⟩"
and eq:"s'' = s⇩1 ∧ v = Null"
by(auto elim:eval_cases intro:Val)
from eq IH evals have "P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val vs,s'⟩" by simp
with eq CallNull[OF val'] e' Some
show "P,E ⊢ ⟨Call (Val v) Copt M es,s⟩ ⇒ ⟨e',s'⟩"
by fastforce
qed
qed
next
case (RedCall s a C S Cs M Ts' T' pns' body' Ds Ts T pns body Cs' vs
bs new_body E s' e')
obtain h l where "s' = (h,l)" by(cases s') auto
have "P,E ⊢ ⟨ref(a,Cs),s⟩ ⇒ ⟨ref(a,Cs),s⟩" by (rule eval_evals.intros)
moreover
have finals: "finals(map Val vs)" by simp
obtain h⇩2 l⇩2 where s: "s = (h⇩2,l⇩2)" by (cases s)
with finals have "P,E ⊢ ⟨map Val vs,s⟩ [⇒] ⟨map Val vs,(h⇩2,l⇩2)⟩"
by (iprover intro: eval_finalsId)
moreover from s have h⇩2a:"h⇩2 a = Some (C,S)" using RedCall by simp
moreover have "method": "P ⊢ last Cs has least M = (Ts',T',pns',body') via Ds" by fact
moreover have select:"P ⊢ (C,Cs@⇩pDs) selects M = (Ts,T,pns,body) via Cs'" by fact
moreover have blocks:"bs = blocks(this#pns,Class(last Cs')#Ts,Ref(a,Cs')#vs,body)" by fact
moreover have body_case:"new_body = (case T' of Class D ⇒ ⦇D⦈bs | _ ⇒ bs)" by fact
moreover have same_len⇩1: "length Ts = length pns"
and this_distinct: "this ∉ set pns" and fv: "fv body ⊆ {this} ∪ set pns"
using select wf by (fastforce dest!:select_method_wf_mdecl simp:wf_mdecl_def)+
have same_len: "length vs = length pns" by fact
moreover
obtain h⇩3 l⇩3 where s': "s' = (h⇩3,l⇩3)" by (cases s')
have eval_blocks:"P,E ⊢ ⟨new_body,s⟩ ⇒ ⟨e',s'⟩" by fact
hence id: "l⇩3 = l⇩2" using fv s s' same_len⇩1 same_len wf blocks body_case
by(cases T')(auto elim!: eval_closed_lcl_unchanged)
from same_len⇩1 have same_len':"length(this#pns) = length(Class (last Cs')#Ts)"
by simp
from same_len⇩1 same_len
have same_len⇩2:"length(this#pns) = length(Ref(a,Cs')#vs)" by simp
from eval_blocks
have eval_blocks':"P,E ⊢ ⟨new_body,(h⇩2,l⇩2)⟩ ⇒ ⟨e',(h⇩3,l⇩3)⟩" using s s' by simp
have casts_unique:"⋀vs'. P ⊢ Class (last Cs')#Ts Casts Ref(a,Cs')#vs to vs'
⟹ vs' = Ref(a,Cs')#tl vs'"
using wf
by -(erule Casts_to.cases,auto elim!:casts_to.cases dest!:mdc_eq_last
simp:path_via_def appendPath_def)
have "∃l'' vs' new_body'. P,E(this↦Class(last Cs'), pns[↦]Ts) ⊢
⟨new_body',(h⇩2,l⇩2(this # pns[↦]Ref(a,Cs')#vs'))⟩ ⇒ ⟨e',(h⇩3, l'')⟩ ∧
P ⊢ Class(last Cs')#Ts Casts Ref(a,Cs')#vs to Ref(a,Cs')#vs' ∧
length vs' = length vs ∧ fv new_body' ⊆ {this} ∪ set pns ∧
new_body' = (case T' of Class D ⇒ ⦇D⦈body | _ ⇒ body)"
proof(cases "∀C. T' ≠ Class C")
case True
with same_len' same_len⇩2 eval_blocks' casts_unique body_case blocks
obtain l'' vs'
where body:"P,E(this↦Class(last Cs'), pns[↦]Ts) ⊢
⟨body,(h⇩2,l⇩2(this # pns[↦]Ref(a,Cs')#vs'))⟩ ⇒ ⟨e',(h⇩3, l'')⟩"
and casts:"P ⊢ Class(last Cs')#Ts Casts Ref(a,Cs')#vs to Ref(a,Cs')#vs'"
and lengthvs':"length vs' = length vs"
by -(drule_tac vs="Ref(a,Cs')#vs" in blocksEval,assumption,cases T',
auto simp:length_Suc_conv,blast)
with fv True show ?thesis by(cases T') auto
next
case False
then obtain D where T':"T' = Class D" by auto
with same_len' same_len⇩2 eval_blocks' casts_unique body_case blocks
obtain l'' vs'
where body:"P,E(this↦Class(last Cs'), pns[↦]Ts) ⊢
⟨⦇D⦈body,(h⇩2,l⇩2(this # pns[↦]Ref(a,Cs')#vs'))⟩ ⇒
⟨e',(h⇩3, l'')⟩"
and casts:"P ⊢ Class(last Cs')#Ts Casts Ref(a,Cs')#vs to Ref(a,Cs')#vs'"
and lengthvs':"length vs' = length vs"
by - (drule_tac vs="Ref(a,Cs')#vs" in CastblocksEval,
assumption,simp,clarsimp simp:length_Suc_conv,auto)
from fv have "fv (⦇D⦈body) ⊆ {this} ∪ set pns"
by simp
with body casts lengthvs' T' show ?thesis by auto
qed
then obtain l'' vs' new_body'
where body:"P,E(this↦Class(last Cs'), pns[↦]Ts) ⊢
⟨new_body',(h⇩2,l⇩2(this # pns[↦]Ref(a,Cs')#vs'))⟩ ⇒ ⟨e',(h⇩3, l'')⟩"
and casts:"P ⊢ Class(last Cs')#Ts Casts Ref(a,Cs')#vs to Ref(a,Cs')#vs'"
and lengthvs':"length vs' = length vs"
and body_case':"new_body' = (case T' of Class D ⇒ ⦇D⦈body | _ ⇒ body)"
and fv':"fv new_body' ⊆ {this} ∪ set pns"
by auto
from same_len⇩2 lengthvs'
have same_len⇩3:"length (this # pns) = length (Ref (a, Cs') # vs')" by simp
from restrict_map_upds[OF same_len⇩3,of "set(this#pns)" "l⇩2"]
have "l⇩2(this # pns[↦]Ref(a,Cs')#vs')|`(set(this#pns)) =
[this # pns[↦]Ref(a,Cs')#vs']" by simp
with eval_restrict_lcl[OF wf body fv'] this_distinct same_len⇩1 same_len
have "P,E(this↦Class(last Cs'), pns[↦]Ts) ⊢
⟨new_body',(h⇩2,[this # pns[↦]Ref(a,Cs')#vs'])⟩ ⇒ ⟨e',(h⇩3, l''|`(set(this#pns)))⟩"
by simp
with casts obtain l⇩2' l⇩3' vs' where
"P ⊢ Ts Casts vs to vs'"
and "P,E(this↦Class(last Cs'), pns[↦]Ts) ⊢
⟨new_body',(h⇩2,l⇩2')⟩ ⇒ ⟨e',(h⇩3,l⇩3')⟩"
and "l⇩2' = [this↦Ref(a,Cs'),pns[↦]vs']"
by(auto elim:Casts_to.cases)
ultimately have "P,E ⊢ ⟨(ref(a,Cs))∙M(map Val vs),s⟩ ⇒ ⟨e',(h⇩3,l⇩2)⟩"
using body_case'
by -(rule Call,simp_all)
with s' id show ?case by simp
next
case (RedStaticCall Cs C Cs'' M Ts T pns body Cs' Ds vs E a s s' e')
have "P,E ⊢ ⟨ref(a,Cs),s⟩ ⇒ ⟨ref(a,Cs),s⟩" by (rule eval_evals.intros)
moreover
have finals: "finals(map Val vs)" by simp
obtain h⇩2 l⇩2 where s: "s = (h⇩2,l⇩2)" by (cases s)
with finals have "P,E ⊢ ⟨map Val vs,s⟩ [⇒] ⟨map Val vs,(h⇩2,l⇩2)⟩"
by (iprover intro: eval_finalsId)
moreover have path_unique:"P ⊢ Path last Cs to C unique" by fact
moreover have path_via:"P ⊢ Path last Cs to C via Cs''" by fact
moreover have least:"P ⊢ C has least M = (Ts, T, pns, body) via Cs'" by fact
moreover have same_len⇩1: "length Ts = length pns"
and this_distinct: "this ∉ set pns" and fv: "fv body ⊆ {this} ∪ set pns"
using least wf by (fastforce dest!:has_least_wf_mdecl simp:wf_mdecl_def)+
moreover have same_len:"length vs = length pns" by fact
moreover have Ds:"Ds = (Cs @⇩p Cs'') @⇩p Cs'" by fact
moreover
obtain h⇩3 l⇩3 where s': "s' = (h⇩3,l⇩3)" by (cases s')
have eval_blocks:"P,E ⊢ ⟨blocks(this#pns,Class(last Ds)#Ts,Ref(a,Ds)#vs,body),s⟩
⇒ ⟨e',s'⟩" by fact
hence id: "l⇩3 = l⇩2" using fv s s' same_len⇩1 same_len wf
by(auto elim!: eval_closed_lcl_unchanged)
from same_len⇩1 have same_len':"length(this#pns) = length(Class (last Ds)#Ts)"
by simp
from same_len⇩1 same_len
have same_len⇩2:"length(this#pns) = length(Ref(a,Ds)#vs)" by simp
from eval_blocks
have eval_blocks':"P,E ⊢ ⟨blocks(this#pns,Class(last Ds)#Ts,Ref(a,Ds)#vs,body),
(h⇩2,l⇩2)⟩ ⇒ ⟨e',(h⇩3,l⇩3)⟩" using s s' by simp
have casts_unique:"⋀vs'. P ⊢ Class (last Ds)#Ts Casts Ref(a,Ds)#vs to vs'
⟹ vs' = Ref(a,Ds)#tl vs'"
using wf
by -(erule Casts_to.cases,auto elim!:casts_to.cases dest!:mdc_eq_last
simp:path_via_def appendPath_def)
from same_len' same_len⇩2 eval_blocks' casts_unique
obtain l'' vs' where body:"P,E(this↦Class(last Ds), pns[↦]Ts) ⊢
⟨body,(h⇩2,l⇩2(this # pns[↦]Ref(a,Ds)#vs'))⟩ ⇒ ⟨e',(h⇩3, l'')⟩"
and casts:"P ⊢ Class(last Ds)#Ts Casts Ref(a,Ds)#vs to Ref(a,Ds)#vs'"
and lengthvs':"length vs' = length vs"
by -(drule_tac vs="Ref(a,Ds)#vs" in blocksEval,auto simp:length_Suc_conv,blast)
from same_len⇩2 lengthvs'
have same_len⇩3:"length (this # pns) = length (Ref(a,Ds) # vs')" by simp
from restrict_map_upds[OF same_len⇩3,of "set(this#pns)" "l⇩2"]
have "l⇩2(this # pns[↦]Ref(a,Ds)#vs')|`(set(this#pns)) =
[this # pns[↦]Ref(a,Ds)#vs']" by simp
with eval_restrict_lcl[OF wf body fv] this_distinct same_len⇩1 same_len
have "P,E(this↦Class(last Ds), pns[↦]Ts) ⊢
⟨body,(h⇩2,[this#pns [↦] Ref(a,Ds)#vs'])⟩ ⇒ ⟨e',(h⇩3, l''|`(set(this#pns)))⟩"
by simp
with casts obtain l⇩2' l⇩3' vs' where
"P ⊢ Ts Casts vs to vs'"
and "P,E(this ↦ Class(last Ds),pns [↦] Ts) ⊢ ⟨body,(h⇩2,l⇩2')⟩ ⇒ ⟨e',(h⇩3,l⇩3')⟩"
and "l⇩2' = [this ↦ Ref(a,Ds),pns [↦] vs']"
by(auto elim:Casts_to.cases)
ultimately have "P,E ⊢ ⟨(ref(a,Cs))∙(C::)M(map Val vs),s⟩ ⇒ ⟨e',(h⇩3,l⇩2)⟩"
by -(rule StaticCall,simp_all)
with s' id show ?case by simp
next
case RedCallNull
thus ?case
by (fastforce elim: eval_cases intro: eval_evals.intros eval_finalsId)
next
case BlockRedNone
thus ?case
by (fastforce elim!: eval_cases intro: eval_evals.intros
simp add: fun_upd_same fun_upd_idem)
next
case (BlockRedSome E V T e h l e'' h' l' v s' e')
have eval:"P,E ⊢ ⟨{V:T:=Val v; e''},(h', l'(V := l V))⟩ ⇒ ⟨e',s'⟩"
and red:"P,E(V ↦ T) ⊢ ⟨e,(h, l(V := None))⟩ → ⟨e'',(h', l')⟩"
and notassigned:"¬ assigned V e" and l':"l' V = Some v"
and IH:"⋀ex sx. P,E(V ↦ T) ⊢ ⟨e'',(h', l')⟩ ⇒ ⟨ex,sx⟩ ⟹
P,E(V ↦ T) ⊢ ⟨e,(h, l(V := None))⟩ ⇒ ⟨ex,sx⟩" by fact+
from l' have l'upd:"l'(V ↦ v) = l'" by (rule map_upd_triv)
from wf red l' have casts:"P ⊢ T casts v to v"
apply -
apply(erule_tac V="V" in None_lcl_casts_values)
by(simp add:fun_upd_same)+
from eval obtain h'' l''
where "P,E(V ↦ T) ⊢ ⟨V:=Val v;; e'',(h',l'(V:=None))⟩ ⇒ ⟨e',(h'',l'')⟩ ∧
s' = (h'',l''(V:=l V))"
by (fastforce elim:eval_cases simp:fun_upd_same fun_upd_idem)
moreover
{ fix T' h⇩0 l⇩0 v' v''
assume eval':"P,E(V ↦ T) ⊢ ⟨e'',(h⇩0,l⇩0(V ↦ v''))⟩ ⇒ ⟨e',(h'', l'')⟩"
and val:"P,E(V ↦ T) ⊢ ⟨Val v,(h', l'(V := None))⟩ ⇒ ⟨Val v',(h⇩0,l⇩0)⟩"
and env:"(E(V ↦ T)) V = Some T'" and casts':"P ⊢ T' casts v' to v''"
from env have TeqT':"T = T'" by (simp add:fun_upd_same)
from val have eq:"v = v' ∧ h' = h⇩0 ∧ l'(V := None) = l⇩0"
by -(erule eval_cases,simp)
with casts casts' wf TeqT' have "v = v''"
by clarsimp(rule casts_casts_eq)
with eq eval'
have "P,E(V ↦ T) ⊢ ⟨e'',(h', l'(V ↦ v))⟩ ⇒ ⟨e',(h'', l'')⟩"
by clarsimp }
ultimately have "P,E(V ↦ T) ⊢ ⟨e'',(h',l'(V ↦ v))⟩ ⇒ ⟨e',(h'',l'')⟩"
and s':"s' = (h'',l''(V:=l V))"
apply auto
apply(erule eval_cases)
apply(erule eval_cases) apply auto
apply(erule eval_cases) apply auto
apply(erule eval_cases) apply auto
done
with l'upd have eval'':"P,E(V ↦ T) ⊢ ⟨e'',(h',l')⟩ ⇒ ⟨e',(h'',l'')⟩"
by simp
from IH[OF eval''] have "P,E(V ↦ T) ⊢ ⟨e,(h, l(V := None))⟩ ⇒ ⟨e',(h'', l'')⟩" .
with s' show ?case by(fastforce intro:Block)
next
case (InitBlockRed E V T e h l v' e'' h' l' v'' v s' e')
have eval:" P,E ⊢ ⟨{V:T:=Val v''; e''},(h', l'(V := l V))⟩ ⇒ ⟨e',s'⟩"
and red:"P,E(V ↦ T) ⊢ ⟨e,(h, l(V ↦ v'))⟩ → ⟨e'',(h', l')⟩"
and casts:"P ⊢ T casts v to v'" and l':"l' V = Some v''"
and IH:"⋀ex sx. P,E(V ↦ T) ⊢ ⟨e'',(h', l')⟩ ⇒ ⟨ex,sx⟩ ⟹
P,E(V ↦ T) ⊢ ⟨e,(h, l(V ↦ v'))⟩ ⇒ ⟨ex,sx⟩" by fact+
from l' have l'upd:"l'(V ↦ v'') = l'" by (rule map_upd_triv)
from wf casts have "P ⊢ T casts v' to v'" by(rule casts_casts)
with wf red l' have casts':"P ⊢ T casts v'' to v''"
apply -
apply(erule_tac V="V" in Some_lcl_casts_values)
by(simp add:fun_upd_same)+
from eval obtain h'' l''
where "P,E(V ↦ T) ⊢ ⟨V:=Val v'';; e'',(h',l'(V:=None))⟩ ⇒ ⟨e',(h'',l'')⟩ ∧
s' = (h'',l''(V:=l V))"
by (fastforce elim:eval_cases simp:fun_upd_same fun_upd_idem)
moreover
{ fix T' v'''
assume eval':"P,E(V ↦ T) ⊢ ⟨e'',(h',l'(V ↦ v'''))⟩ ⇒ ⟨e',(h'', l'')⟩"
and env:"(E(V ↦ T)) V = Some T'" and casts'':"P ⊢ T' casts v'' to v'''"
from env have "T = T'" by (simp add:fun_upd_same)
with casts' casts'' wf have "v'' = v'''" by simp(rule casts_casts_eq)
with eval' have "P,E(V ↦ T) ⊢ ⟨e'',(h', l'(V ↦ v''))⟩ ⇒ ⟨e',(h'', l'')⟩" by simp }
ultimately have "P,E(V ↦ T) ⊢ ⟨e'',(h',l'(V ↦ v''))⟩ ⇒ ⟨e',(h'',l'')⟩"
and s':"s' = (h'',l''(V:=l V))"
by(auto elim!:eval_cases)
with l'upd have eval'':"P,E(V ↦ T) ⊢ ⟨e'',(h',l')⟩ ⇒ ⟨e',(h'',l'')⟩"
by simp
from IH[OF eval'']
have evale:"P,E(V ↦ T) ⊢ ⟨e,(h, l(V ↦ v'))⟩ ⇒ ⟨e',(h'', l'')⟩" .
from casts
have "P,E(V ↦ T) ⊢ ⟨V:=Val v,(h,l(V:=None))⟩ ⇒ ⟨Val v',(h,l(V ↦ v'))⟩"
by -(rule_tac l="l(V:=None)" in LAss,
auto intro:eval_evals.intros simp:fun_upd_same)
with evale s' show ?case by(fastforce intro:Block Seq)
next
case (RedBlock E V T v s s' e')
have "P,E ⊢ ⟨Val v,s⟩ ⇒ ⟨e',s'⟩" by fact
then obtain s': "s'=s" and e': "e'=Val v"
by cases simp
obtain h l where s: "s=(h,l)" by (cases s)
have "P,E(V ↦ T) ⊢ ⟨Val v,(h,l(V:=None))⟩ ⇒ ⟨Val v,(h,l(V:=None))⟩"
by (rule eval_evals.intros)
hence "P,E ⊢ ⟨{V:T;Val v},(h,l)⟩ ⇒ ⟨Val v,(h,(l(V:=None))(V:=l V))⟩"
by (rule eval_evals.Block)
thus "P,E ⊢ ⟨{V:T; Val v},s⟩ ⇒ ⟨e',s'⟩"
using s s' e'
by simp
next
case (RedInitBlock T v v' E V u s s' e')
have "P,E ⊢ ⟨Val u,s⟩ ⇒ ⟨e',s'⟩" and casts:"P ⊢ T casts v to v'" by fact+
then obtain s': "s' = s" and e': "e'=Val u" by cases simp
obtain h l where s: "s=(h,l)" by (cases s)
have val:"P,E(V ↦ T) ⊢ ⟨Val v,(h,l(V:=None))⟩ ⇒ ⟨Val v,(h,l(V:=None))⟩"
by (rule eval_evals.intros)
with casts
have "P,E(V ↦ T) ⊢ ⟨V:=Val v,(h,l(V:=None))⟩ ⇒ ⟨Val v',(h,l(V ↦ v'))⟩"
by -(rule_tac l="l(V:=None)" in LAss,auto simp:fun_upd_same)
hence "P,E ⊢ ⟨{V:T :=Val v; Val u},(h,l)⟩ ⇒ ⟨Val u,(h, (l(V↦v'))(V:=l V))⟩"
by (fastforce intro!: eval_evals.intros)
thus ?case using s s' e' by simp
next
case SeqRed thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case RedSeq thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case CondRed thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case RedCondT thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case RedCondF thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case RedWhile
thus ?case by (auto simp add: unfold_while intro:eval_evals.intros elim:eval_cases)
next
case ThrowRed thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case RedThrowNull
thus ?case by -(auto elim!:eval_cases intro!:eval_evals.ThrowNull eval_finalId)
next
case ListRed1 thus ?case by (fastforce elim: evals_cases intro: eval_evals.intros)
next
case ListRed2
thus ?case by (fastforce elim!: evals_cases eval_cases
intro: eval_evals.intros eval_finalId)
next
case StaticCastThrow
thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case DynCastThrow
thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case BinOpThrow1 thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case BinOpThrow2 thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case LAssThrow thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case FAccThrow thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case FAssThrow1 thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case FAssThrow2 thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case CallThrowObj thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case (CallThrowParams es vs r es' E v Copt M s s' e')
have "P,E ⊢ ⟨Val v,s⟩ ⇒ ⟨Val v,s⟩" by (rule eval_evals.intros)
moreover
have es: "es = map Val vs @ Throw r # es'" by fact
have eval_e: "P,E ⊢ ⟨Throw r,s⟩ ⇒ ⟨e',s'⟩" by fact
then obtain s': "s' = s" and e': "e' = Throw r"
by cases (auto elim!:eval_cases)
with list_eval_Throw [OF eval_e] es
have "P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val vs @ Throw r # es',s'⟩" by simp
ultimately have "P,E ⊢ ⟨Call (Val v) Copt M es,s⟩ ⇒ ⟨Throw r,s'⟩"
by (rule eval_evals.CallParamsThrow)
thus ?case using e' by simp
next
case (BlockThrow E V T r s s' e')
have "P,E ⊢ ⟨Throw r, s⟩ ⇒ ⟨e',s'⟩" by fact
then obtain s': "s' = s" and e': "e' = Throw r"
by cases (auto elim!:eval_cases)
obtain h l where s: "s=(h,l)" by (cases s)
have "P,E(V ↦ T) ⊢ ⟨Throw r, (h,l(V:=None))⟩ ⇒ ⟨Throw r, (h,l(V:=None))⟩"
by (simp add:eval_evals.intros eval_finalId)
hence "P,E ⊢ ⟨{V:T;Throw r},(h,l)⟩ ⇒ ⟨Throw r, (h,(l(V:=None))(V:=l V))⟩"
by (rule eval_evals.Block)
thus "P,E ⊢ ⟨{V:T; Throw r},s⟩ ⇒ ⟨e',s'⟩" using s s' e' by simp
next
case (InitBlockThrow T v v' E V r s s' e')
have "P,E ⊢ ⟨Throw r,s⟩ ⇒ ⟨e',s'⟩" and casts:"P ⊢ T casts v to v'" by fact+
then obtain s': "s' = s" and e': "e' = Throw r"
by cases (auto elim!:eval_cases)
obtain h l where s: "s = (h,l)" by (cases s)
have "P,E(V ↦ T) ⊢ ⟨Val v,(h,l(V:=None))⟩ ⇒ ⟨Val v,(h,l(V:=None))⟩"
by (rule eval_evals.intros)
with casts
have "P,E(V ↦ T) ⊢ ⟨V:=Val v,(h,l(V := None))⟩ ⇒ ⟨Val v',(h,l(V ↦ v'))⟩"
by -(rule_tac l="l(V:=None)" in LAss,auto simp:fun_upd_same)
hence "P,E ⊢ ⟨{V:T := Val v; Throw r},(h,l)⟩ ⇒ ⟨Throw r, (h, (l(V↦v'))(V:=l V))⟩"
by(fastforce intro:eval_evals.intros)
thus "P,E ⊢ ⟨{V:T := Val v; Throw r},s⟩ ⇒ ⟨e',s'⟩" using s s' e' by simp
next
case SeqThrow thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case CondThrow thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case ThrowThrow thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
qed
declare split_paired_All [simp] split_paired_Ex [simp]
setup ‹map_theory_claset (fn ctxt => ctxt addSbefore ("split_all_tac", split_all_tac))›
setup ‹map_theory_simpset (fn ctxt => ctxt addloop ("split_all_tac", split_all_tac))›
text ‹Its extension to ‹→*›:›
lemma extend_eval:
assumes wf: "wwf_prog P"
and reds: "P,E ⊢ ⟨e,s⟩ →* ⟨e'',s''⟩" and eval_rest: "P,E ⊢ ⟨e'',s''⟩ ⇒ ⟨e',s'⟩"
shows "P,E ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩"
using reds eval_rest
apply (induct rule: converse_rtrancl_induct2)
apply simp
apply simp
apply (rule extend_1_eval)
apply (rule wf)
apply assumption+
done
lemma extend_evals:
assumes wf: "wwf_prog P"
and reds: "P,E ⊢ ⟨es,s⟩ [→]* ⟨es'',s''⟩" and eval_rest: "P,E ⊢ ⟨es'',s''⟩ [⇒] ⟨es',s'⟩"
shows "P,E ⊢ ⟨es,s⟩ [⇒] ⟨es',s'⟩"
using reds eval_rest
apply (induct rule: converse_rtrancl_induct2)
apply simp
apply simp
apply (rule extend_1_evals)
apply (rule wf)
apply assumption+
done
text ‹Finally, small step semantics can be simulated by big step semantics:
›
theorem
assumes wf: "wwf_prog P"
shows small_by_big: "⟦P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩; final e'⟧ ⟹ P,E ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩"
and "⟦P,E ⊢ ⟨es,s⟩ [→]* ⟨es',s'⟩; finals es'⟧ ⟹ P,E ⊢ ⟨es,s⟩ [⇒] ⟨es',s'⟩"
proof -
note wf
moreover assume "P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩"
moreover assume "final e'"
then have "P,E ⊢ ⟨e',s'⟩ ⇒ ⟨e',s'⟩"
by (rule eval_finalId)
ultimately show "P,E ⊢ ⟨e,s⟩⇒⟨e',s'⟩"
by (rule extend_eval)
next
note wf
moreover assume "P,E ⊢ ⟨es,s⟩ [→]* ⟨es',s'⟩"
moreover assume "finals es'"
then have "P,E ⊢ ⟨es',s'⟩ [⇒] ⟨es',s'⟩"
by (rule eval_finalsId)
ultimately show "P,E ⊢ ⟨es,s⟩ [⇒] ⟨es',s'⟩"
by (rule extend_evals)
qed
subsection ‹Equivalence›
text‹And now, the crowning achievement:›
corollary big_iff_small:
"wwf_prog P ⟹
P,E ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩ = (P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ∧ final e')"
by(blast dest: big_by_small eval_final small_by_big)
end
Theory DefAss
section ‹Definite assignment›
theory DefAss
imports BigStep
begin
subsection ‹Hypersets›
type_synonym hyperset = "vname set option"
definition hyperUn :: "hyperset ⇒ hyperset ⇒ hyperset" (infixl "⊔" 65) where
"A ⊔ B ≡ case A of None ⇒ None
| ⌊A⌋ ⇒ (case B of None ⇒ None | ⌊B⌋ ⇒ ⌊A ∪ B⌋)"
definition hyperInt :: "hyperset ⇒ hyperset ⇒ hyperset" (infixl "⊓" 70) where
"A ⊓ B ≡ case A of None ⇒ B
| ⌊A⌋ ⇒ (case B of None ⇒ ⌊A⌋ | ⌊B⌋ ⇒ ⌊A ∩ B⌋)"
definition hyperDiff1 :: "hyperset ⇒ vname ⇒ hyperset" (infixl "⊖" 65) where
"A ⊖ a ≡ case A of None ⇒ None | ⌊A⌋ ⇒ ⌊A - {a}⌋"
definition hyper_isin :: "vname ⇒ hyperset ⇒ bool" (infix "∈∈" 50) where
"a ∈∈ A ≡ case A of None ⇒ True | ⌊A⌋ ⇒ a ∈ A"
definition hyper_subset :: "hyperset ⇒ hyperset ⇒ bool" (infix "⊑" 50) where
"A ⊑ B ≡ case B of None ⇒ True
| ⌊B⌋ ⇒ (case A of None ⇒ False | ⌊A⌋ ⇒ A ⊆ B)"
lemmas hyperset_defs =
hyperUn_def hyperInt_def hyperDiff1_def hyper_isin_def hyper_subset_def
lemma [simp]: "⌊{}⌋ ⊔ A = A ∧ A ⊔ ⌊{}⌋ = A"
by(simp add:hyperset_defs)
lemma [simp]: "⌊A⌋ ⊔ ⌊B⌋ = ⌊A ∪ B⌋ ∧ ⌊A⌋ ⊖ a = ⌊A - {a}⌋"
by(simp add:hyperset_defs)
lemma [simp]: "None ⊔ A = None ∧ A ⊔ None = None"
by(simp add:hyperset_defs)
lemma [simp]: "a ∈∈ None ∧ None ⊖ a = None"
by(simp add:hyperset_defs)
lemma hyperUn_assoc: "(A ⊔ B) ⊔ C = A ⊔ (B ⊔ C)"
by(simp add:hyperset_defs Un_assoc)
lemma hyper_insert_comm: "A ⊔ ⌊{a}⌋ = ⌊{a}⌋ ⊔ A ∧ A ⊔ (⌊{a}⌋ ⊔ B) = ⌊{a}⌋ ⊔ (A ⊔ B)"
by(simp add:hyperset_defs)
subsection ‹Definite assignment›
primrec 𝒜 :: "expr ⇒ hyperset" and 𝒜s :: "expr list ⇒ hyperset" where
"𝒜 (new C) = ⌊{}⌋" |
"𝒜 (Cast C e) = 𝒜 e" |
"𝒜 (⦇C⦈e) = 𝒜 e" |
"𝒜 (Val v) = ⌊{}⌋" |
"𝒜 (e⇩1 «bop» e⇩2) = 𝒜 e⇩1 ⊔ 𝒜 e⇩2" |
"𝒜 (Var V) = ⌊{}⌋" |
"𝒜 (LAss V e) = ⌊{V}⌋ ⊔ 𝒜 e" |
"𝒜 (e∙F{Cs}) = 𝒜 e" |
"𝒜 (e⇩1∙F{Cs}:=e⇩2) = 𝒜 e⇩1 ⊔ 𝒜 e⇩2" |
"𝒜 (Call e Copt M es) = 𝒜 e ⊔ 𝒜s es" |
"𝒜 ({V:T; e}) = 𝒜 e ⊖ V" |
"𝒜 (e⇩1;;e⇩2) = 𝒜 e⇩1 ⊔ 𝒜 e⇩2" |
"𝒜 (if (e) e⇩1 else e⇩2) = 𝒜 e ⊔ (𝒜 e⇩1 ⊓ 𝒜 e⇩2)" |
"𝒜 (while (b) e) = 𝒜 b" |
"𝒜 (throw e) = None" |
"𝒜s ([]) = ⌊{}⌋" |
"𝒜s (e#es) = 𝒜 e ⊔ 𝒜s es"
primrec 𝒟 :: "expr ⇒ hyperset ⇒ bool" and 𝒟s :: "expr list ⇒ hyperset ⇒ bool" where
"𝒟 (new C) A = True" |
"𝒟 (Cast C e) A = 𝒟 e A" |
"𝒟 (⦇C⦈e) A = 𝒟 e A" |
"𝒟 (Val v) A = True" |
"𝒟 (e⇩1 «bop» e⇩2) A = (𝒟 e⇩1 A ∧ 𝒟 e⇩2 (A ⊔ 𝒜 e⇩1))" |
"𝒟 (Var V) A = (V ∈∈ A)" |
"𝒟 (LAss V e) A = 𝒟 e A" |
"𝒟 (e∙F{Cs}) A = 𝒟 e A" |
"𝒟 (e⇩1∙F{Cs}:=e⇩2) A = (𝒟 e⇩1 A ∧ 𝒟 e⇩2 (A ⊔ 𝒜 e⇩1))" |
"𝒟 (Call e Copt M es) A = (𝒟 e A ∧ 𝒟s es (A ⊔ 𝒜 e))" |
"𝒟 ({V:T; e}) A = 𝒟 e (A ⊖ V)" |
"𝒟 (e⇩1;;e⇩2) A = (𝒟 e⇩1 A ∧ 𝒟 e⇩2 (A ⊔ 𝒜 e⇩1))" |
"𝒟 (if (e) e⇩1 else e⇩2) A =
(𝒟 e A ∧ 𝒟 e⇩1 (A ⊔ 𝒜 e) ∧ 𝒟 e⇩2 (A ⊔ 𝒜 e))" |
"𝒟 (while (e) c) A = (𝒟 e A ∧ 𝒟 c (A ⊔ 𝒜 e))" |
"𝒟 (throw e) A = 𝒟 e A" |
"𝒟s ([]) A = True" |
"𝒟s (e#es) A = (𝒟 e A ∧ 𝒟s es (A ⊔ 𝒜 e))"
lemma As_map_Val[simp]: "𝒜s (map Val vs) = ⌊{}⌋"
by (induct vs) simp_all
lemma D_append[iff]: "⋀A. 𝒟s (es @ es') A = (𝒟s es A ∧ 𝒟s es' (A ⊔ 𝒜s es))"
by (induct es type:list) (auto simp:hyperUn_assoc)
lemma A_fv: "⋀A. 𝒜 e = ⌊A⌋ ⟹ A ⊆ fv e"
and "⋀A. 𝒜s es = ⌊A⌋ ⟹ A ⊆ fvs es"
apply(induct e and es rule: 𝒜.induct 𝒜s.induct)
apply (simp_all add:hyperset_defs)
apply blast+
done
lemma sqUn_lem: "A ⊑ A' ⟹ A ⊔ B ⊑ A' ⊔ B"
by(simp add:hyperset_defs) blast
lemma diff_lem: "A ⊑ A' ⟹ A ⊖ b ⊑ A' ⊖ b"
by(simp add:hyperset_defs) blast
lemma D_mono: "⋀A A'. A ⊑ A' ⟹ 𝒟 e A ⟹ 𝒟 (e::expr) A'"
and Ds_mono: "⋀A A'. A ⊑ A' ⟹ 𝒟s es A ⟹ 𝒟s (es::expr list) A'"
apply(induct e and es rule: 𝒟.induct 𝒟s.induct)
apply simp
apply simp
apply simp
apply simp
apply simp apply (iprover dest:sqUn_lem)
apply (fastforce simp add:hyperset_defs)
apply simp
apply simp
apply simp apply (iprover dest:sqUn_lem)
apply simp apply (iprover dest:sqUn_lem)
apply simp apply (iprover dest:diff_lem)
apply simp apply (iprover dest:sqUn_lem)
apply simp apply (iprover dest:sqUn_lem)
apply simp apply (iprover dest:sqUn_lem)
apply simp
apply simp
apply simp
apply (iprover dest:sqUn_lem)
done
lemma D_mono': "𝒟 e A ⟹ A ⊑ A' ⟹ 𝒟 e A'"
and Ds_mono': "𝒟s es A ⟹ A ⊑ A' ⟹ 𝒟s es A'"
by(blast intro:D_mono, blast intro:Ds_mono)
end
Theory WellTypeRT
section ‹Runtime Well-typedness›
theory WellTypeRT imports WellType begin
subsection ‹Run time types›
primrec typeof_h :: "prog ⇒ heap ⇒ val ⇒ ty option" ("_ ⊢ typeof⇘_⇙") where
"P ⊢ typeof⇘h⇙ Unit = Some Void"
| "P ⊢ typeof⇘h⇙ Null = Some NT"
| "P ⊢ typeof⇘h⇙ (Bool b) = Some Boolean"
| "P ⊢ typeof⇘h⇙ (Intg i) = Some Integer"
| "P ⊢ typeof⇘h⇙ (Ref r) = (case h (the_addr (Ref r)) of None ⇒ None
| Some(C,S) ⇒ (if Subobjs P C (the_path(Ref r)) then
Some(Class(last(the_path(Ref r))))
else None))"
lemma type_eq_type: "typeof v = Some T ⟹ P ⊢ typeof⇘h⇙ v = Some T"
by(induct v)auto
lemma typeof_Void [simp]: "P ⊢ typeof⇘h⇙ v = Some Void ⟹ v = Unit"
by(induct v,auto split:if_split_asm)
lemma typeof_NT [simp]: "P ⊢ typeof⇘h⇙ v = Some NT ⟹ v = Null"
by(induct v,auto split:if_split_asm)
lemma typeof_Boolean [simp]: "P ⊢ typeof⇘h⇙ v = Some Boolean ⟹ ∃b. v = Bool b"
by(induct v,auto split:if_split_asm)
lemma typeof_Integer [simp]: "P ⊢ typeof⇘h⇙ v = Some Integer ⟹ ∃i. v = Intg i"
by(induct v,auto split:if_split_asm)
lemma typeof_Class_Subo:
"P ⊢ typeof⇘h⇙ v = Some (Class C) ⟹
∃a Cs D S. v = Ref(a,Cs) ∧ h a = Some(D,S) ∧ Subobjs P D Cs ∧ last Cs = C"
by(induct v,auto split:if_split_asm)
subsection ‹The rules›
inductive
WTrt :: "[prog,env,heap,expr, ty ] ⇒ bool"
("_,_,_ ⊢ _ : _" [51,51,51]50)
and WTrts :: "[prog,env,heap,expr list,ty list] ⇒ bool"
("_,_,_ ⊢ _ [:] _" [51,51,51]50)
for P :: prog
where
WTrtNew:
"is_class P C ⟹
P,E,h ⊢ new C : Class C"
| WTrtDynCast:
"⟦ P,E,h ⊢ e : T; is_refT T; is_class P C ⟧
⟹ P,E,h ⊢ Cast C e : Class C"
| WTrtStaticCast:
"⟦ P,E,h ⊢ e : T; is_refT T; is_class P C ⟧
⟹ P,E,h ⊢ ⦇C⦈e : Class C"
| WTrtVal:
"P ⊢ typeof⇘h⇙ v = Some T ⟹
P,E,h ⊢ Val v : T"
| WTrtVar:
"E V = Some T ⟹
P,E,h ⊢ Var V : T"
| WTrtBinOp:
"⟦ P,E,h ⊢ e⇩1 : T⇩1; P,E,h ⊢ e⇩2 : T⇩2;
case bop of Eq ⇒ T = Boolean
| Add ⇒ T⇩1 = Integer ∧ T⇩2 = Integer ∧ T = Integer ⟧
⟹ P,E,h ⊢ e⇩1 «bop» e⇩2 : T"
| WTrtLAss:
"⟦ E V = Some T; P,E,h ⊢ e : T'; P ⊢ T' ≤ T ⟧
⟹ P,E,h ⊢ V:=e : T"
| WTrtFAcc:
"⟦P,E,h ⊢ e : Class C; Cs ≠ []; P ⊢ C has least F:T via Cs ⟧
⟹ P,E,h ⊢ e∙F{Cs} : T"
| WTrtFAccNT:
"P,E,h ⊢ e : NT ⟹ P,E,h ⊢ e∙F{Cs} : T"
| WTrtFAss:
"⟦P,E,h ⊢ e⇩1 : Class C; Cs ≠ [];
P ⊢ C has least F:T via Cs; P,E,h ⊢ e⇩2 : T'; P ⊢ T' ≤ T ⟧
⟹ P,E,h ⊢ e⇩1∙F{Cs}:=e⇩2 : T"
| WTrtFAssNT:
"⟦ P,E,h ⊢ e⇩1 : NT; P,E,h ⊢ e⇩2 : T'; P ⊢ T' ≤ T ⟧
⟹ P,E,h ⊢ e⇩1∙F{Cs}:=e⇩2 : T"
| WTrtCall:
"⟦ P,E,h ⊢ e : Class C; P ⊢ C has least M = (Ts,T,m) via Cs;
P,E,h ⊢ es [:] Ts'; P ⊢ Ts' [≤] Ts ⟧
⟹ P,E,h ⊢ e∙M(es) : T"
| WTrtStaticCall:
"⟦ P,E,h ⊢ e : Class C'; P ⊢ Path C' to C unique;
P ⊢ C has least M = (Ts,T,m) via Cs;
P,E,h ⊢ es [:] Ts'; P ⊢ Ts' [≤] Ts ⟧
⟹ P,E,h ⊢ e∙(C::)M(es) : T"
| WTrtCallNT:
"⟦P,E,h ⊢ e : NT; P,E,h ⊢ es [:] Ts⟧ ⟹ P,E,h ⊢ Call e Copt M es : T"
| WTrtBlock:
"⟦P,E(V↦T),h ⊢ e : T'; is_type P T⟧ ⟹
P,E,h ⊢ {V:T; e} : T'"
| WTrtSeq:
"⟦ P,E,h ⊢ e⇩1 : T⇩1; P,E,h ⊢ e⇩2 : T⇩2 ⟧ ⟹ P,E,h ⊢ e⇩1;;e⇩2 : T⇩2"
| WTrtCond:
"⟦ P,E,h ⊢ e : Boolean; P,E,h ⊢ e⇩1 : T; P,E,h ⊢ e⇩2 : T ⟧
⟹ P,E,h ⊢ if (e) e⇩1 else e⇩2 : T"
| WTrtWhile:
"⟦ P,E,h ⊢ e : Boolean; P,E,h ⊢ c : T ⟧
⟹ P,E,h ⊢ while(e) c : Void"
| WTrtThrow:
"⟦P,E,h ⊢ e : T'; is_refT T'⟧
⟹ P,E,h ⊢ throw e : T"
| WTrtNil:
"P,E,h ⊢ [] [:] []"
| WTrtCons:
"⟦ P,E,h ⊢ e : T; P,E,h ⊢ es [:] Ts ⟧ ⟹ P,E,h ⊢ e#es [:] T#Ts"
declare
WTrt_WTrts.intros[intro!]
WTrtNil[iff]
declare
WTrtFAcc[rule del] WTrtFAccNT[rule del]
WTrtFAss[rule del] WTrtFAssNT[rule del]
WTrtCall[rule del] WTrtCallNT[rule del]
lemmas WTrt_induct = WTrt_WTrts.induct [split_format (complete)]
and WTrt_inducts = WTrt_WTrts.inducts [split_format (complete)]
subsection‹Easy consequences›
inductive_simps [iff]:
"P,E,h ⊢ [] [:] Ts"
"P,E,h ⊢ e#es [:] T#Ts"
"P,E,h ⊢ (e#es) [:] Ts"
"P,E,h ⊢ Val v : T"
"P,E,h ⊢ Var V : T"
"P,E,h ⊢ e⇩1;;e⇩2 : T⇩2"
"P,E,h ⊢ {V:T; e} : T'"
lemma [simp]: "∀Ts. (P,E,h ⊢ es⇩1 @ es⇩2 [:] Ts) =
(∃Ts⇩1 Ts⇩2. Ts = Ts⇩1 @ Ts⇩2 ∧ P,E,h ⊢ es⇩1 [:] Ts⇩1 & P,E,h ⊢ es⇩2 [:] Ts⇩2)"
apply(induct_tac es⇩1)
apply simp
apply clarsimp
apply(erule thin_rl)
apply (rule iffI)
apply clarsimp
apply(rule exI)+
apply(rule conjI)
prefer 2 apply blast
apply simp
apply fastforce
done
inductive_cases WTrt_elim_cases[elim!]:
"P,E,h ⊢ new C : T"
"P,E,h ⊢ Cast C e : T"
"P,E,h ⊢ ⦇C⦈e : T"
"P,E,h ⊢ e⇩1 «bop» e⇩2 : T"
"P,E,h ⊢ V:=e : T"
"P,E,h ⊢ e∙F{Cs} : T"
"P,E,h ⊢ e∙F{Cs} := v : T"
"P,E,h ⊢ e∙M(es) : T"
"P,E,h ⊢ e∙(C::)M(es) : T"
"P,E,h ⊢ if (e) e⇩1 else e⇩2 : T"
"P,E,h ⊢ while(e) c : T"
"P,E,h ⊢ throw e : T"
subsection‹Some interesting lemmas›
lemma WTrts_Val[simp]:
"⋀Ts. (P,E,h ⊢ map Val vs [:] Ts) = (map (λv. (P ⊢ typeof⇘h⇙) v) vs = map Some Ts)"
apply(induct vs)
apply fastforce
apply(case_tac Ts)
apply simp
apply simp
done
lemma WTrts_same_length: "⋀Ts. P,E,h ⊢ es [:] Ts ⟹ length es = length Ts"
by(induct es type:list)auto
lemma WTrt_env_mono:
"P,E,h ⊢ e : T ⟹ (⋀E'. E ⊆⇩m E' ⟹ P,E',h ⊢ e : T)" and
"P,E,h ⊢ es [:] Ts ⟹ (⋀E'. E ⊆⇩m E' ⟹ P,E',h ⊢ es [:] Ts)"
apply(induct rule: WTrt_inducts)
apply(simp add: WTrtNew)
apply(fastforce simp: WTrtDynCast)
apply(fastforce simp: WTrtStaticCast)
apply(fastforce simp: WTrtVal)
apply(simp add: WTrtVar map_le_def dom_def)
apply(fastforce simp add: WTrtBinOp)
apply (force simp:map_le_def)
apply(fastforce simp: WTrtFAcc)
apply(simp add: WTrtFAccNT)
apply(fastforce simp: WTrtFAss)
apply(fastforce simp: WTrtFAssNT)
apply(fastforce simp: WTrtCall)
apply(fastforce simp: WTrtStaticCall)
apply(fastforce simp: WTrtCallNT)
apply(fastforce simp: map_le_def)
apply(fastforce)
apply(fastforce simp: WTrtCond)
apply(fastforce simp: WTrtWhile)
apply(fastforce simp: WTrtThrow)
apply(simp add: WTrtNil)
apply(simp add: WTrtCons)
done
lemma WT_implies_WTrt: "P,E ⊢ e :: T ⟹ P,E,h ⊢ e : T"
and WTs_implies_WTrts: "P,E ⊢ es [::] Ts ⟹ P,E,h ⊢ es [:] Ts"
proof(induct rule: WT_WTs_inducts)
case WTVal thus ?case by (fastforce dest:type_eq_type)
next
case WTBinOp thus ?case by (fastforce split:bop.splits)
next
case WTFAcc thus ?case
by(fastforce intro!:WTrtFAcc dest:Subobjs_nonempty
simp:LeastFieldDecl_def FieldDecls_def)
next
case WTFAss thus ?case
by(fastforce intro!:WTrtFAss dest:Subobjs_nonempty
simp:LeastFieldDecl_def FieldDecls_def)
next
case WTCall thus ?case by (fastforce intro:WTrtCall)
qed (auto simp del:fun_upd_apply)
end
Theory Conform
section ‹Conformance Relations for Proofs›
theory Conform
imports Exceptions WellTypeRT
begin
primrec conf :: "prog ⇒ heap ⇒ val ⇒ ty ⇒ bool" ("_,_ ⊢ _ :≤ _" [51,51,51,51] 50) where
"P,h ⊢ v :≤ Void = (P ⊢ typeof⇘h⇙ v = Some Void)"
| "P,h ⊢ v :≤ Boolean = (P ⊢ typeof⇘h⇙ v = Some Boolean)"
| "P,h ⊢ v :≤ Integer = (P ⊢ typeof⇘h⇙ v = Some Integer)"
| "P,h ⊢ v :≤ NT = (P ⊢ typeof⇘h⇙ v = Some NT)"
| "P,h ⊢ v :≤ (Class C) = (P ⊢ typeof⇘h⇙ v = Some(Class C) ∨ P ⊢ typeof⇘h⇙ v = Some NT)"
definition fconf :: "prog ⇒ heap ⇒ ('a ⇀ val) ⇒ ('a ⇀ ty) ⇒ bool" ("_,_ ⊢ _ '(:≤') _" [51,51,51,51] 50) where
"P,h ⊢ v⇩m (:≤) T⇩m ≡
∀FD T. T⇩m FD = Some T ⟶ (∃v. v⇩m FD = Some v ∧ P,h ⊢ v :≤ T)"
definition oconf :: "prog ⇒ heap ⇒ obj ⇒ bool" ("_,_ ⊢ _ √" [51,51,51] 50) where
"P,h ⊢ obj √ ≡ let (C,S) = obj in
(∀Cs. Subobjs P C Cs ⟶ (∃!fs'. (Cs,fs') ∈ S)) ∧
(∀Cs fs'. (Cs,fs') ∈ S ⟶ Subobjs P C Cs ∧
(∃fs Bs ms. class P (last Cs) = Some (Bs,fs,ms) ∧
P,h ⊢ fs' (:≤) map_of fs))"
definition hconf :: "prog ⇒ heap ⇒ bool" ("_ ⊢ _ √" [51,51] 50) where
"P ⊢ h √ ≡
(∀a obj. h a = Some obj ⟶ P,h ⊢ obj √) ∧ preallocated h"
definition lconf :: "prog ⇒ heap ⇒ ('a ⇀ val) ⇒ ('a ⇀ ty) ⇒ bool" ("_,_ ⊢ _ '(:≤')⇩w _" [51,51,51,51] 50) where
"P,h ⊢ v⇩m (:≤)⇩w T⇩m ≡
∀V v. v⇩m V = Some v ⟶ (∃T. T⇩m V = Some T ∧ P,h ⊢ v :≤ T)"
abbreviation
confs :: "prog ⇒ heap ⇒ val list ⇒ ty list ⇒ bool"
("_,_ ⊢ _ [:≤] _" [51,51,51,51] 50) where
"P,h ⊢ vs [:≤] Ts ≡ list_all2 (conf P h) vs Ts"
subsection‹Value conformance ‹:≤››
lemma conf_Null [simp]: "P,h ⊢ Null :≤ T = P ⊢ NT ≤ T"
by(cases T) simp_all
lemma typeof_conf[simp]: "P ⊢ typeof⇘h⇙ v = Some T ⟹ P,h ⊢ v :≤ T"
by (cases T) auto
lemma typeof_lit_conf[simp]: "typeof v = Some T ⟹ P,h ⊢ v :≤ T"
by (rule typeof_conf[OF type_eq_type])
lemma defval_conf[simp]: "is_type P T ⟹ P,h ⊢ default_val T :≤ T"
by(cases T) auto
lemma typeof_notclass_heap:
"∀C. T ≠ Class C ⟹ (P ⊢ typeof⇘h⇙ v = Some T) = (P ⊢ typeof⇘h'⇙ v = Some T)"
by(cases T)(auto dest:typeof_Void typeof_NT typeof_Boolean typeof_Integer)
lemma assumes h:"h a = Some(C,S)"
shows conf_upd_obj: "(P,h(a↦(C,S')) ⊢ v :≤ T) = (P,h ⊢ v :≤ T)"
proof(cases T)
case Void
hence "(P ⊢ typeof⇘h(a↦(C,S'))⇙ v = Some T) = (P ⊢ typeof⇘h⇙ v = Some T)"
by(fastforce intro!:typeof_notclass_heap)
with Void show ?thesis by simp
next
case Boolean
hence "(P ⊢ typeof⇘h(a↦(C,S'))⇙ v = Some T) = (P ⊢ typeof⇘h⇙ v = Some T)"
by(fastforce intro!:typeof_notclass_heap)
with Boolean show ?thesis by simp
next
case Integer
hence "(P ⊢ typeof⇘h(a↦(C,S'))⇙ v = Some T) = (P ⊢ typeof⇘h⇙ v = Some T)"
by(fastforce intro!:typeof_notclass_heap)
with Integer show ?thesis by simp
next
case NT
hence "(P ⊢ typeof⇘h(a↦(C,S'))⇙ v = Some T) = (P ⊢ typeof⇘h⇙ v = Some T)"
by(fastforce intro!:typeof_notclass_heap)
with NT show ?thesis by simp
next
case (Class C')
{ assume "P ⊢ typeof⇘h(a ↦ (C, S'))⇙ v = Some(Class C')"
with h have "P ⊢ typeof⇘h⇙ v = Some(Class C')"
by (cases v) (auto split:if_split_asm) }
hence 1:"P ⊢ typeof⇘h(a ↦ (C, S'))⇙ v = Some(Class C') ⟹
P ⊢ typeof⇘h⇙ v = Some(Class C')" by simp
{ assume type:"P ⊢ typeof⇘h(a ↦ (C, S'))⇙ v = Some NT"
and typenot:"P ⊢ typeof⇘h⇙ v ≠ Some NT"
have "∀C. NT ≠ Class C" by simp
with type have "P ⊢ typeof⇘h⇙ v = Some NT" by(fastforce dest:typeof_notclass_heap)
with typenot have "P ⊢ typeof⇘h⇙ v = Some(Class C')" by simp }
hence 2:"⟦P ⊢ typeof⇘h(a ↦ (C, S'))⇙ v = Some NT; P ⊢ typeof⇘h⇙ v ≠ Some NT⟧ ⟹
P ⊢ typeof⇘h⇙ v = Some(Class C')" by simp
{ assume "P ⊢ typeof⇘h⇙ v = Some(Class C')"
with h have "P ⊢ typeof⇘h(a ↦ (C, S'))⇙ v = Some(Class C')"
by (cases v) (auto split:if_split_asm) }
hence 3:"P ⊢ typeof⇘h⇙ v = Some(Class C') ⟹
P ⊢ typeof⇘h(a ↦ (C, S'))⇙ v = Some(Class C')" by simp
{ assume typenot:"P ⊢ typeof⇘h(a ↦ (C, S'))⇙ v ≠ Some NT"
and type:"P ⊢ typeof⇘h⇙ v = Some NT"
have "∀C. NT ≠ Class C" by simp
with type have "P ⊢ typeof⇘h(a ↦ (C, S'))⇙ v = Some NT"
by(fastforce dest:typeof_notclass_heap)
with typenot have "P ⊢ typeof⇘h(a ↦ (C, S'))⇙ v = Some(Class C')" by simp }
hence 4:"⟦P ⊢ typeof⇘h(a ↦ (C, S'))⇙ v ≠ Some NT; P ⊢ typeof⇘h⇙ v = Some NT⟧ ⟹
P ⊢ typeof⇘h(a ↦ (C, S'))⇙ v = Some(Class C')" by simp
from Class show ?thesis by (auto intro:1 2 3 4)
qed
lemma conf_NT [iff]: "P,h ⊢ v :≤ NT = (v = Null)"
by fastforce
subsection‹Value list conformance ‹[:≤]››
lemma confs_rev: "P,h ⊢ rev s [:≤] t = (P,h ⊢ s [:≤] rev t)"
apply rule
apply (rule subst [OF list_all2_rev])
apply simp
apply (rule subst [OF list_all2_rev])
apply simp
done
lemma confs_Cons2: "P,h ⊢ xs [:≤] y#ys = (∃z zs. xs = z#zs ∧ P,h ⊢ z :≤ y ∧ P,h ⊢ zs [:≤] ys)"
by (rule list_all2_Cons2)
subsection‹Field conformance ‹(:≤)››
lemma fconf_init_fields:
"class P C = Some(Bs,fs,ms) ⟹ P,h ⊢ init_class_fieldmap P C (:≤) map_of fs"
apply(unfold fconf_def init_class_fieldmap_def)
apply clarsimp
apply (rule exI)
apply (rule conjI)
apply (simp add:map_of_map)
apply(case_tac T)
apply simp_all
done
subsection‹Heap conformance›
lemma hconfD: "⟦ P ⊢ h √; h a = Some obj ⟧ ⟹ P,h ⊢ obj √"
apply (unfold hconf_def)
apply (fast)
done
lemma hconf_Subobjs:
"⟦h a = Some(C,S); (Cs, fs) ∈ S; P ⊢ h √⟧ ⟹ Subobjs P C Cs"
apply (unfold hconf_def)
apply clarsimp
apply (erule_tac x="a" in allE)
apply (erule_tac x="C" in allE)
apply (erule_tac x="S" in allE)
apply clarsimp
apply (unfold oconf_def)
apply fastforce
done
subsection ‹Local variable conformance›
lemma lconf_upd:
"⟦ P,h ⊢ l (:≤)⇩w E; P,h ⊢ v :≤ T; E V = Some T ⟧ ⟹ P,h ⊢ l(V↦v) (:≤)⇩w E"
apply (unfold lconf_def)
apply auto
done
lemma lconf_empty[iff]: "P,h ⊢ Map.empty (:≤)⇩w E"
by(simp add:lconf_def)
lemma lconf_upd2: "⟦P,h ⊢ l (:≤)⇩w E; P,h ⊢ v :≤ T⟧ ⟹ P,h ⊢ l(V↦v) (:≤)⇩w E(V↦T)"
by(simp add:lconf_def)
subsection‹Environment conformance›
definition envconf :: "prog ⇒ env ⇒ bool" ("_ ⊢ _ √" [51,51] 50) where
"P ⊢ E √ ≡ ∀V T. E V = Some T ⟶ is_type P T"
subsection‹Type conformance›
primrec
type_conf :: "prog ⇒ env ⇒ heap ⇒ expr ⇒ ty ⇒ bool"
("_,_,_ ⊢ _ :⇘NT⇙ _" [51,51,51]50)
where
type_conf_Void: "P,E,h ⊢ e :⇘NT⇙ Void ⟷ (P,E,h ⊢ e : Void)"
| type_conf_Boolean: "P,E,h ⊢ e :⇘NT⇙ Boolean ⟷ (P,E,h ⊢ e : Boolean)"
| type_conf_Integer: "P,E,h ⊢ e :⇘NT⇙ Integer ⟷ (P,E,h ⊢ e : Integer)"
| type_conf_NT: "P,E,h ⊢ e :⇘NT⇙ NT ⟷ (P,E,h ⊢ e : NT)"
| type_conf_Class: "P,E,h ⊢ e :⇘NT⇙ Class C ⟷
(P,E,h ⊢ e : Class C ∨ P,E,h ⊢ e : NT)"
fun
types_conf :: "prog ⇒ env ⇒ heap ⇒ expr list ⇒ ty list ⇒ bool"
("_,_,_ ⊢ _ [:]⇘NT⇙ _" [51,51,51]50)
where
"P,E,h ⊢ [] [:]⇘NT⇙ [] ⟷ True"
| "P,E,h ⊢ (e#es) [:]⇘NT⇙ (T#Ts) ⟷
(P,E,h ⊢ e:⇘NT⇙ T ∧ P,E,h ⊢ es [:]⇘NT⇙ Ts)"
| "P,E,h ⊢ es [:]⇘NT⇙ Ts ⟷ False"
lemma wt_same_type_typeconf:
"P,E,h ⊢ e : T ⟹ P,E,h ⊢ e :⇘NT⇙ T"
by(cases T) auto
lemma wts_same_types_typesconf:
"P,E,h ⊢ es [:] Ts ⟹ types_conf P E h es Ts"
proof(induct Ts arbitrary: es)
case Nil thus ?case by (auto elim:WTrts.cases)
next
case (Cons T' Ts')
have wtes:"P,E,h ⊢ es [:] T'#Ts'"
and IH:"⋀es. P,E,h ⊢ es [:] Ts' ⟹ types_conf P E h es Ts'" by fact+
from wtes obtain e' es' where es:"es = e'#es'" by(cases es) auto
with wtes have wte':"P,E,h ⊢ e' : T'" and wtes':"P,E,h ⊢ es' [:] Ts'"
by simp_all
from IH[OF wtes'] wte' es show ?case by (fastforce intro:wt_same_type_typeconf)
qed
lemma types_conf_smaller_types:
"⋀es Ts. ⟦length es = length Ts'; types_conf P E h es Ts'; P ⊢ Ts' [≤] Ts ⟧
⟹ ∃Ts''. P,E,h ⊢ es [:] Ts'' ∧ P ⊢ Ts'' [≤] Ts"
proof(induct Ts')
case Nil thus ?case by simp
next
case (Cons S Ss)
have length:"length es = length(S#Ss)"
and types_conf:"types_conf P E h es (S#Ss)"
and subs:"P ⊢ (S#Ss) [≤] Ts"
and IH:"⋀es Ts. ⟦length es = length Ss; types_conf P E h es Ss; P ⊢ Ss [≤] Ts⟧
⟹ ∃Ts''. P,E,h ⊢ es [:] Ts'' ∧ P ⊢ Ts'' [≤] Ts" by fact+
from subs obtain U Us where Ts:"Ts = U#Us" by(cases Ts) auto
from length obtain e' es' where es:"es = e'#es'" by(cases es) auto
with types_conf have type:"P,E,h ⊢ e' :⇘NT⇙ S"
and type':"types_conf P E h es' Ss" by simp_all
from subs Ts have subs':"P ⊢ Ss [≤] Us" and sub:"P ⊢ S ≤ U"
by (simp_all add:fun_of_def)
from sub type obtain T'' where step:"P,E,h ⊢ e' : T'' ∧ P ⊢ T'' ≤ U"
by(cases S,auto,cases U,auto)
from length es have "length es' = length Ss" by simp
from IH[OF this type' subs'] obtain Ts''
where "P,E,h ⊢ es' [:] Ts'' ∧ P ⊢ Ts'' [≤] Us"
by auto
with step have "P,E,h ⊢ (e'#es') [:] (T''#Ts'') ∧ P ⊢ (T''#Ts'') [≤] (U#Us)"
by (auto simp:fun_of_def)
with es Ts show ?case by blast
qed
end
Theory Progress
section ‹Progress of Small Step Semantics›
theory Progress imports Equivalence DefAss Conform begin
subsection ‹Some pre-definitions›
lemma final_refE:
"⟦ P,E,h ⊢ e : Class C; final e;
⋀r. e = ref r ⟹ Q;
⋀r. e = Throw r ⟹ Q ⟧ ⟹ Q"
by (simp add:final_def,auto,case_tac v,auto)
lemma finalRefE:
"⟦ P,E,h ⊢ e : T; is_refT T; final e;
e = null ⟹ Q;
⋀r. e = ref r ⟹ Q;
⋀r. e = Throw r ⟹ Q⟧ ⟹ Q"
apply (cases T)
apply (simp add:is_refT_def)+
apply (simp add:final_def)
apply (erule disjE)
apply clarsimp
apply (erule exE)+
apply fastforce
apply (auto simp:final_def is_refT_def)
apply (case_tac v)
apply auto
done
lemma subE:
"⟦ P ⊢ T ≤ T'; is_type P T'; wf_prog wf_md P;
⟦ T = T'; ∀C. T ≠ Class C ⟧ ⟹ Q;
⋀C D. ⟦ T = Class C; T' = Class D; P ⊢ Path C to D unique ⟧ ⟹ Q;
⋀C. ⟦ T = NT; T' = Class C ⟧ ⟹ Q ⟧ ⟹ Q"
apply(cases T')
apply auto
apply(drule_tac T = "T" in widen_Class)
apply auto
done
lemma assumes wf:"wf_prog wf_md P"
and typeof:" P ⊢ typeof⇘h⇙ v = Some T'"
and type:"is_type P T"
shows sub_casts:"P ⊢ T' ≤ T ⟹ ∃v'. P ⊢ T casts v to v'"
proof(erule subE)
from type show "is_type P T" .
next
from wf show "wf_prog wf_md P" .
next
assume "T' = T" and "∀C. T' ≠ Class C"
thus "∃v'. P ⊢ T casts v to v'" by(fastforce intro:casts_prim)
next
fix C D
assume T':"T' = Class C" and T:"T = Class D"
and path_unique:"P ⊢ Path C to D unique"
from T' typeof obtain a Cs where v:"v = Ref(a,Cs)" and last:"last Cs = C"
by(auto dest!:typeof_Class_Subo)
from last path_unique obtain Cs' where "P ⊢ Path last Cs to D via Cs'"
by(auto simp:path_unique_def path_via_def)
hence "P ⊢ Class D casts Ref(a,Cs) to Ref(a,Cs@⇩pCs')"
by -(rule casts_ref,simp_all)
with T v show "∃v'. P ⊢ T casts v to v'" by auto
next
fix C
assume "T' = NT" and T:"T = Class C"
with typeof have "v = Null" by simp
with T show "∃v'. P ⊢ T casts v to v'" by(fastforce intro:casts_null)
qed
text‹Derivation of new induction scheme for well typing:›
inductive
WTrt' :: "[prog,env,heap,expr, ty ] ⇒ bool"
("_,_,_ ⊢ _ :'' _" [51,51,51]50)
and WTrts':: "[prog,env,heap,expr list,ty list] ⇒ bool"
("_,_,_ ⊢ _ [:''] _" [51,51,51]50)
for P :: prog
where
"is_class P C ⟹ P,E,h ⊢ new C :' Class C"
| "⟦is_class P C; P,E,h ⊢ e :' T; is_refT T⟧
⟹ P,E,h ⊢ Cast C e :' Class C"
| "⟦is_class P C; P,E,h ⊢ e :' T; is_refT T⟧
⟹ P,E,h ⊢ ⦇C⦈e :' Class C"
| "P ⊢ typeof⇘h⇙ v = Some T ⟹ P,E,h ⊢ Val v :' T"
| "E V = Some T ⟹ P,E,h ⊢ Var V :' T"
| "⟦ P,E,h ⊢ e⇩1 :' T⇩1; P,E,h ⊢ e⇩2 :' T⇩2;
case bop of Eq ⇒ T = Boolean
| Add ⇒ T⇩1 = Integer ∧ T⇩2 = Integer ∧ T = Integer ⟧
⟹ P,E,h ⊢ e⇩1 «bop» e⇩2 :' T"
| "⟦ P,E,h ⊢ Var V :' T; P,E,h ⊢ e :' T' ; P ⊢ T' ≤ T ⟧
⟹ P,E,h ⊢ V:=e :' T"
| "⟦P,E,h ⊢ e :' Class C; Cs ≠ []; P ⊢ C has least F:T via Cs⟧
⟹ P,E,h ⊢ e∙F{Cs} :' T"
| "P,E,h ⊢ e :' NT ⟹ P,E,h ⊢ e∙F{Cs} :' T"
| "⟦P,E,h ⊢ e⇩1 :' Class C; Cs ≠ []; P ⊢ C has least F:T via Cs;
P,E,h ⊢ e⇩2 :' T'; P ⊢ T' ≤ T ⟧
⟹ P,E,h ⊢ e⇩1∙F{Cs}:=e⇩2 :' T"
| "⟦ P,E,h ⊢ e⇩1:'NT; P,E,h ⊢ e⇩2 :' T'; P ⊢ T' ≤ T ⟧
⟹ P,E,h ⊢ e⇩1∙F{Cs}:=e⇩2 :' T"
| "⟦ P,E,h ⊢ e :' Class C; P ⊢ C has least M = (Ts,T,m) via Cs;
P,E,h ⊢ es [:'] Ts'; P ⊢ Ts' [≤] Ts ⟧
⟹ P,E,h ⊢ e∙M(es) :' T"
| "⟦ P,E,h ⊢ e :' Class C'; P ⊢ Path C' to C unique;
P ⊢ C has least M = (Ts,T,m) via Cs;
P,E,h ⊢ es [:'] Ts'; P ⊢ Ts' [≤] Ts ⟧
⟹ P,E,h ⊢ e∙(C::)M(es) :' T"
| "⟦P,E,h ⊢ e :' NT; P,E,h ⊢ es [:'] Ts⟧ ⟹ P,E,h ⊢ Call e Copt M es :' T"
| "⟦ P ⊢ typeof⇘h⇙ v = Some T'; P,E(V↦T),h ⊢ e⇩2 :' T⇩2; P ⊢ T' ≤ T; is_type P T ⟧
⟹ P,E,h ⊢ {V:T := Val v; e⇩2} :' T⇩2"
| "⟦ P,E(V↦T),h ⊢ e :' T'; ¬ assigned V e; is_type P T ⟧
⟹ P,E,h ⊢ {V:T; e} :' T'"
| "⟦ P,E,h ⊢ e⇩1 :' T⇩1; P,E,h ⊢ e⇩2 :' T⇩2 ⟧ ⟹ P,E,h ⊢ e⇩1;;e⇩2 :' T⇩2"
| "⟦ P,E,h ⊢ e :' Boolean; P,E,h ⊢ e⇩1:' T; P,E,h ⊢ e⇩2:' T ⟧
⟹ P,E,h ⊢ if (e) e⇩1 else e⇩2 :' T"
| "⟦ P,E,h ⊢ e :' Boolean; P,E,h ⊢ c:' T ⟧
⟹ P,E,h ⊢ while(e) c :' Void"
| "⟦ P,E,h ⊢ e :' T'; is_refT T'⟧ ⟹ P,E,h ⊢ throw e :' T"
| "P,E,h ⊢ [] [:'] []"
| "⟦ P,E,h ⊢ e :' T; P,E,h ⊢ es [:'] Ts ⟧ ⟹ P,E,h ⊢ e#es [:'] T#Ts"
lemmas WTrt'_induct = WTrt'_WTrts'.induct [split_format (complete)]
and WTrt'_inducts = WTrt'_WTrts'.inducts [split_format (complete)]
inductive_cases WTrt'_elim_cases[elim!]:
"P,E,h ⊢ V :=e :' T"
text‹... and some easy consequences:›
lemma [iff]: "P,E,h ⊢ e⇩1;;e⇩2 :' T⇩2 = (∃T⇩1. P,E,h ⊢ e⇩1:' T⇩1 ∧ P,E,h ⊢ e⇩2:' T⇩2)"
apply(rule iffI)
apply (auto elim: WTrt'.cases intro!:WTrt'_WTrts'.intros)
done
lemma [iff]: "P,E,h ⊢ Val v :' T = (P ⊢ typeof⇘h⇙ v = Some T)"
apply(rule iffI)
apply (auto elim: WTrt'.cases intro!:WTrt'_WTrts'.intros)
done
lemma [iff]: "P,E,h ⊢ Var V :' T = (E V = Some T)"
apply(rule iffI)
apply (auto elim: WTrt'.cases intro!:WTrt'_WTrts'.intros)
done
lemma wt_wt': "P,E,h ⊢ e : T ⟹ P,E,h ⊢ e :' T"
and wts_wts': "P,E,h ⊢ es [:] Ts ⟹ P,E,h ⊢ es [:'] Ts"
proof (induct rule:WTrt_inducts)
case (WTrtBlock E V T h e T')
thus ?case
apply(case_tac "assigned V e")
apply(auto intro:WTrt'_WTrts'.intros
simp add:fun_upd_same assigned_def simp del:fun_upd_apply)
done
qed(auto intro:WTrt'_WTrts'.intros simp del:fun_upd_apply)
lemma wt'_wt: "P,E,h ⊢ e :' T ⟹ P,E,h ⊢ e : T"
and wts'_wts: "P,E,h ⊢ es [:'] Ts ⟹ P,E,h ⊢ es [:] Ts"
apply (induct rule:WTrt'_inducts)
apply (fastforce intro: WTrt_WTrts.intros)+
done
corollary wt'_iff_wt: "(P,E,h ⊢ e :' T) = (P,E,h ⊢ e : T)"
by(blast intro:wt_wt' wt'_wt)
corollary wts'_iff_wts: "(P,E,h ⊢ es [:'] Ts) = (P,E,h ⊢ es [:] Ts)"
by(blast intro:wts_wts' wts'_wts)
lemmas WTrt_inducts2 = WTrt'_inducts [unfolded wt'_iff_wt wts'_iff_wts,
case_names WTrtNew WTrtDynCast WTrtStaticCast WTrtVal WTrtVar WTrtBinOp
WTrtLAss WTrtFAcc WTrtFAccNT WTrtFAss WTrtFAssNT WTrtCall WTrtStaticCall WTrtCallNT
WTrtInitBlock WTrtBlock WTrtSeq WTrtCond WTrtWhile WTrtThrow
WTrtNil WTrtCons, consumes 1]
subsection‹The theorem ‹progress››
lemma mdc_leq_dyn_type:
"P,E,h ⊢ e : T ⟹
∀C a Cs D S. T = Class C ∧ e = ref(a,Cs) ∧ h a = Some(D,S) ⟶ P ⊢ D ≼⇧* C"
and "P,E,h ⊢ es [:] Ts ⟹
∀T Ts' e es' C a Cs D S. Ts = T#Ts' ∧ es = e#es' ∧
T = Class C ∧ e = ref(a,Cs) ∧ h a = Some(D,S)
⟶ P ⊢ D ≼⇧* C"
proof (induct rule:WTrt_inducts2)
case (WTrtVal h v T E)
have type:"P ⊢ typeof⇘h⇙ v = Some T" by fact
{ fix C a Cs D S
assume "T = Class C" and "Val v = ref(a,Cs)" and "h a = Some(D,S)"
with type have "Subobjs P D Cs" and "C = last Cs" by (auto split:if_split_asm)
hence "P ⊢ D ≼⇧* C" by simp (rule Subobjs_subclass) }
thus ?case by blast
qed auto
lemma appendPath_append_last:
assumes notempty:"Ds ≠ []"
shows"(Cs @⇩p Ds) @⇩p [last Ds] = (Cs @⇩p Ds)"
proof -
have "last Cs = hd Ds ⟹ last (Cs @ tl Ds) = last Ds"
proof(cases "tl Ds = []")
case True
assume last:"last Cs = hd Ds"
with True notempty have "Ds = [last Cs]" by (fastforce dest:hd_Cons_tl)
hence "last Ds = last Cs" by simp
with True show ?thesis by simp
next
case False
assume last:"last Cs = hd Ds"
from notempty False have "last (tl Ds) = last Ds"
by -(drule hd_Cons_tl,drule_tac x="hd Ds" in last_ConsR,simp)
with False show ?thesis by simp
qed
thus ?thesis by(simp add:appendPath_def)
qed
theorem assumes wf: "wwf_prog P"
shows progress: "P,E,h ⊢ e : T ⟹
(⋀l. ⟦ P ⊢ h √; P ⊢ E √; 𝒟 e ⌊dom l⌋; ¬ final e ⟧ ⟹ ∃e' s'. P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',s'⟩)"
and "P,E,h ⊢ es [:] Ts ⟹
(⋀l. ⟦ P ⊢ h √; P ⊢ E √; 𝒟s es ⌊dom l⌋; ¬ finals es ⟧ ⟹ ∃es' s'. P,E ⊢ ⟨es,(h,l)⟩ [→] ⟨es',s'⟩)"
proof (induct rule:WTrt_inducts2)
case (WTrtNew C E h)
show ?case
proof cases
assume "∃a. h a = None"
with WTrtNew show ?thesis
by (fastforce del:exE intro!:RedNew simp:new_Addr_def)
next
assume "¬(∃a. h a = None)"
with WTrtNew show ?thesis
by(fastforce intro:RedNewFail simp add:new_Addr_def)
qed
next
case (WTrtDynCast C E h e T)
have wte: "P,E,h ⊢ e : T" and refT: "is_refT T" and "class": "is_class P C"
and IH: "⋀l. ⟦P ⊢ h √; P ⊢ E √; 𝒟 e ⌊dom l⌋; ¬ final e⟧
⟹ ∃e' s'. P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',s'⟩"
and D: "𝒟 (Cast C e) ⌊dom l⌋"
and hconf: "P ⊢ h √" and envconf:"P ⊢ E √" by fact+
from D have De: "𝒟 e ⌊dom l⌋" by auto
show ?case
proof cases
assume "final e"
with wte refT show ?thesis
proof (rule finalRefE)
assume "e = null" thus ?case by(fastforce intro:RedDynCastNull)
next
fix r assume "e = ref r"
then obtain a Cs where ref:"e = ref(a,Cs)" by (cases r) auto
with wte obtain D S where h:"h a = Some(D,S)" by auto
show ?thesis
proof (cases "P ⊢ Path D to C unique")
case True
then obtain Cs' where path:"P ⊢ Path D to C via Cs'"
by (fastforce simp:path_via_def path_unique_def)
then obtain Ds where "Ds = appendPath Cs Cs'" by simp
with h path True ref show ?thesis by (fastforce intro:RedDynCast)
next
case False
hence path_not_unique:"¬ P ⊢ Path D to C unique" .
show ?thesis
proof(cases "P ⊢ Path last Cs to C unique")
case True
then obtain Cs' where "P ⊢ Path last Cs to C via Cs'"
by(auto simp:path_via_def path_unique_def)
with True ref show ?thesis by(fastforce intro:RedStaticUpDynCast)
next
case False
hence path_not_unique':"¬ P ⊢ Path last Cs to C unique" .
thus ?thesis
proof(cases "C ∉ set Cs")
case False
then obtain Ds Ds' where "Cs = Ds@[C]@Ds'"
by (auto simp:in_set_conv_decomp)
with ref show ?thesis by(fastforce intro:RedStaticDownDynCast)
next
case True
with path_not_unique path_not_unique' h ref
show ?thesis by (fastforce intro:RedDynCastFail)
qed
qed
qed
next
fix r assume "e = Throw r"
thus ?thesis by(blast intro!:red_reds.DynCastThrow)
qed
next
assume nf: "¬ final e"
from IH[OF hconf envconf De nf] show ?thesis by (blast intro:DynCastRed)
qed
next
case (WTrtStaticCast C E h e T)
have wte: "P,E,h ⊢ e : T" and refT: "is_refT T" and "class": "is_class P C"
and IH: "⋀l. ⟦P ⊢ h √; P ⊢ E √; 𝒟 e ⌊dom l⌋; ¬ final e⟧
⟹ ∃e' s'. P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',s'⟩"
and D: "𝒟 (⦇C⦈e) ⌊dom l⌋"
and hconf: "P ⊢ h √" and envconf:"P ⊢ E √" by fact+
from D have De: "𝒟 e ⌊dom l⌋" by auto
show ?case
proof cases
assume "final e"
with wte refT show ?thesis
proof (rule finalRefE)
assume "e = null" with "class" show ?case by(fastforce intro:RedStaticCastNull)
next
fix r assume "e = ref r"
then obtain a Cs where ref:"e = ref(a,Cs)" by (cases r) auto
with wte wf have "class":"is_class P (last Cs)"
by (auto intro:Subobj_last_isClass split:if_split_asm)
show ?thesis
proof(cases "P ⊢ (last Cs) ≼⇧* C")
case True
with "class" wf obtain Cs' where "P ⊢ Path last Cs to C via Cs'"
by(fastforce dest:leq_implies_path)
with True ref show ?thesis by(fastforce intro:RedStaticUpCast)
next
case False
have notleq:"¬ P ⊢ last Cs ≼⇧* C" by fact
thus ?thesis
proof(cases "C ∉ set Cs")
case False
then obtain Ds Ds' where "Cs = Ds@[C]@Ds'"
by (auto simp:in_set_conv_decomp)
with ref show ?thesis
by(fastforce intro:RedStaticDownCast)
next
case True
with ref notleq show ?thesis by (fastforce intro:RedStaticCastFail)
qed
qed
next
fix r assume "e = Throw r"
thus ?thesis by(blast intro!:red_reds.StaticCastThrow)
qed
next
assume nf: "¬ final e"
from IH[OF hconf envconf De nf] show ?thesis by (blast intro:StaticCastRed)
qed
next
case WTrtVal thus ?case by(simp add:final_def)
next
case WTrtVar thus ?case by(fastforce intro:RedVar simp:hyper_isin_def)
next
case (WTrtBinOp E h e1 T1 e2 T2 bop T')
have bop:"case bop of Eq ⇒ T' = Boolean
| Add ⇒ T1 = Integer ∧ T2 = Integer ∧ T' = Integer"
and wte1:"P,E,h ⊢ e1 : T1" and wte2:"P,E,h ⊢ e2 : T2" by fact+
show ?case
proof cases
assume "final e1"
thus ?thesis
proof (rule finalE)
fix v1 assume e1 [simp]:"e1 = Val v1"
show ?thesis
proof cases
assume "final e2"
thus ?thesis
proof (rule finalE)
fix v2 assume e2 [simp]:"e2 = Val v2"
show ?thesis
proof (cases bop)
assume "bop = Eq"
thus ?thesis using WTrtBinOp by(fastforce intro:RedBinOp)
next
assume Add:"bop = Add"
with e1 e2 wte1 wte2 bop obtain i1 i2
where "v1 = Intg i1" and "v2 = Intg i2"
by (auto dest!:typeof_Integer)
with Add obtain v where "binop(bop,v1,v2) = Some v" by simp
with e1 e2 show ?thesis by (fastforce intro:RedBinOp)
qed
next
fix a assume "e2 = Throw a"
thus ?thesis by(auto intro:red_reds.BinOpThrow2)
qed
next
assume "¬ final e2" with WTrtBinOp show ?thesis
by simp (fast intro!:BinOpRed2)
qed
next
fix r assume "e1 = Throw r"
thus ?thesis by simp (fast intro:red_reds.BinOpThrow1)
qed
next
assume "¬ final e1" with WTrtBinOp show ?thesis
by simp (fast intro:BinOpRed1)
qed
next
case (WTrtLAss E h V T e T')
have wte:"P,E,h ⊢ e : T'"
and wtvar:"P,E,h ⊢ Var V : T"
and sub:"P ⊢ T' ≤ T"
and envconf:"P ⊢ E √" by fact+
from envconf wtvar have type:"is_type P T" by(auto simp:envconf_def)
show ?case
proof cases
assume fin:"final e"
from fin show ?case
proof (rule finalE)
fix v assume e:"e = Val v"
from sub type wf show ?case
proof(rule subE)
assume eq:"T' = T" and "∀C. T' ≠ Class C"
hence "P ⊢ T casts v to v"
by simp(rule casts_prim)
with wte wtvar eq e show ?thesis
by(auto intro!:RedLAss)
next
fix C D
assume T':"T' = Class C" and T:"T = Class D"
and path_unique:"P ⊢ Path C to D unique"
from wte e T' obtain a Cs where ref:"e = ref(a,Cs)"
and last:"last Cs = C"
by (auto dest!:typeof_Class_Subo)
from path_unique obtain Cs' where path_via:"P ⊢ Path C to D via Cs'"
by(auto simp:path_unique_def path_via_def)
with last have "P ⊢ Class D casts Ref(a,Cs) to Ref(a,Cs@⇩pCs')"
by (fastforce intro:casts_ref simp:path_via_def)
with wte wtvar T ref show ?thesis
by(auto intro!:RedLAss)
next
fix C
assume T':"T' = NT" and T:"T = Class C"
with wte e have null:"e = null" by auto
have "P ⊢ Class C casts Null to Null"
by -(rule casts_null)
with wte wtvar T null show ?thesis
by(auto intro!:RedLAss)
qed
next
fix r assume "e = Throw r"
thus ?thesis by(fastforce intro:red_reds.LAssThrow)
qed
next
assume "¬ final e" with WTrtLAss show ?thesis
by simp (fast intro:LAssRed)
qed
next
case (WTrtFAcc E h e C Cs F T)
have wte: "P,E,h ⊢ e : Class C"
and field: "P ⊢ C has least F:T via Cs"
and notemptyCs:"Cs ≠ []"
and hconf: "P ⊢ h √" by fact+
show ?case
proof cases
assume "final e"
with wte show ?thesis
proof (rule final_refE)
fix r assume e: "e = ref r"
then obtain a Cs' where ref:"e = ref(a,Cs')" by (cases r) auto
with wte obtain D S where h:"h a = Some(D,S)" and suboD:"Subobjs P D Cs'"
and last:"last Cs' = C"
by (fastforce split:if_split_asm)
from field obtain Bs fs ms
where "class": "class P (last Cs) = Some(Bs,fs,ms)"
and fs:"map_of fs F = Some T"
by (fastforce simp:LeastFieldDecl_def FieldDecls_def)
obtain Ds where Ds:"Ds = Cs'@⇩pCs" by simp
with notemptyCs "class" have class':"class P (last Ds) = Some(Bs,fs,ms)"
by (drule_tac Cs'="Cs'" in appendPath_last) simp
from field suboD last Ds wf have subo:"Subobjs P D Ds"
by(fastforce intro:Subobjs_appendPath simp:LeastFieldDecl_def FieldDecls_def)
with hconf h have "P,h ⊢ (D,S) √" by (auto simp:hconf_def)
with class' subo obtain fs' where S:"(Ds,fs') ∈ S"
and "P,h ⊢ fs' (:≤) map_of fs"
apply (auto simp:oconf_def)
apply (erule_tac x="Ds" in allE)
apply auto
apply (erule_tac x="Ds" in allE)
apply (erule_tac x="fs'" in allE)
apply auto
done
with fs obtain v where "fs' F = Some v"
by (fastforce simp:fconf_def)
with h last Ds S
have "P,E ⊢ ⟨(ref (a,Cs'))∙F{Cs}, (h,l)⟩ → ⟨Val v,(h,l)⟩"
by (fastforce intro:RedFAcc)
with ref show ?thesis by blast
next
fix r assume "e = Throw r"
thus ?thesis by(fastforce intro:red_reds.FAccThrow)
qed
next
assume "¬ final e" with WTrtFAcc show ?thesis
by(fastforce intro!:FAccRed)
qed
next
case (WTrtFAccNT E h e F Cs T)
show ?case
proof cases
assume "final e"
with WTrtFAccNT show ?thesis
by(fastforce simp:final_def intro: RedFAccNull red_reds.FAccThrow
dest!:typeof_NT)
next
assume "¬ final e"
with WTrtFAccNT show ?thesis by simp (fast intro:FAccRed)
qed
next
case (WTrtFAss E h e⇩1 C Cs F T e⇩2 T')
have wte1:"P,E,h ⊢ e⇩1 : Class C"
and wte2:"P,E,h ⊢ e⇩2 : T'"
and field:"P ⊢ C has least F:T via Cs"
and notemptyCs:"Cs ≠ []"
and sub:"P ⊢ T' ≤ T"
and hconf:"P ⊢ h √" by fact+
from field wf have type:"is_type P T" by(rule least_field_is_type)
show ?case
proof cases
assume "final e⇩1"
with wte1 show ?thesis
proof (rule final_refE)
fix r assume e1: "e⇩1 = ref r"
show ?thesis
proof cases
assume "final e⇩2"
thus ?thesis
proof (rule finalE)
fix v assume e2:"e⇩2 = Val v"
from e1 obtain a Cs' where ref:"e⇩1 = ref(a,Cs')" by (cases r) auto
with wte1 obtain D S where h:"h a = Some(D,S)"
and suboD:"Subobjs P D Cs'" and last:"last Cs' = C"
by (fastforce split:if_split_asm)
from field obtain Bs fs ms
where "class": "class P (last Cs) = Some(Bs,fs,ms)"
and fs:"map_of fs F = Some T"
by (fastforce simp:LeastFieldDecl_def FieldDecls_def)
obtain Ds where Ds:"Ds = Cs'@⇩pCs" by simp
with notemptyCs "class" have class':"class P (last Ds) = Some(Bs,fs,ms)"
by (drule_tac Cs'="Cs'" in appendPath_last) simp
from field suboD last Ds wf have subo:"Subobjs P D Ds"
by(fastforce intro:Subobjs_appendPath
simp:LeastFieldDecl_def FieldDecls_def)
with hconf h have "P,h ⊢ (D,S) √" by (auto simp:hconf_def)
with class' subo obtain fs' where S:"(Ds,fs') ∈ S"
by (auto simp:oconf_def)
from sub type wf show ?thesis
proof(rule subE)
assume eq:"T' = T" and "∀C. T' ≠ Class C"
hence "P ⊢ T casts v to v"
by simp(rule casts_prim)
with h last field Ds notemptyCs S eq
have "P,E ⊢ ⟨(ref (a,Cs'))∙F{Cs}:=(Val v), (h,l)⟩ →
⟨Val v, (h(a ↦ (D,insert (Ds,fs'(F↦v)) (S - {(Ds,fs')}))),l)⟩"
by (fastforce intro:RedFAss)
with ref e2 show ?thesis by blast
next
fix C' D'
assume T':"T' = Class C'" and T:"T = Class D'"
and path_unique:"P ⊢ Path C' to D' unique"
from wte2 e2 T' obtain a' Cs'' where ref2:"e⇩2 = ref(a',Cs'')"
and last':"last Cs'' = C'"
by (auto dest!:typeof_Class_Subo)
from path_unique obtain Ds' where "P ⊢ Path C' to D' via Ds'"
by(auto simp:path_via_def path_unique_def)
with last'
have casts:"P ⊢ Class D' casts Ref(a',Cs'') to Ref(a',Cs''@⇩pDs')"
by (fastforce intro:casts_ref simp:path_via_def)
obtain v' where "v' = Ref(a',Cs''@⇩pDs')" by simp
with h last field Ds notemptyCs S ref e2 ref2 T casts
have "P,E ⊢ ⟨(ref (a,Cs'))∙F{Cs}:=(Val v), (h,l)⟩ →
⟨Val v',(h(a ↦ (D,insert (Ds,fs'(F↦v'))(S-{(Ds,fs')}))),l)⟩"
by (fastforce intro:RedFAss)
with ref e2 show ?thesis by blast
next
fix C'
assume T':"T' = NT" and T:"T = Class C'"
from e2 wte2 T' have null:"e⇩2 = null" by auto
have casts:"P ⊢ Class C' casts Null to Null"
by -(rule casts_null)
obtain v' where "v' = Null" by simp
with h last field Ds notemptyCs S ref e2 null T casts
have "P,E ⊢ ⟨(ref (a,Cs'))∙F{Cs}:=(Val v), (h,l)⟩ →
⟨Val v', (h(a ↦ (D,insert (Ds,fs'(F↦v')) (S - {(Ds,fs')}))),l)⟩"
by (fastforce intro:RedFAss)
with ref e2 show ?thesis by blast
qed
next
fix r assume "e⇩2 = Throw r"
thus ?thesis using e1 by(fastforce intro:red_reds.FAssThrow2)
qed
next
assume "¬ final e⇩2" with WTrtFAss e1 show ?thesis
by simp (fast intro!:FAssRed2)
qed
next
fix r assume "e⇩1 = Throw r"
thus ?thesis by(fastforce intro:red_reds.FAssThrow1)
qed
next
assume "¬ final e⇩1" with WTrtFAss show ?thesis
by simp (blast intro!:FAssRed1)
qed
next
case (WTrtFAssNT E h e⇩1 e⇩2 T' T F Cs)
show ?case
proof cases
assume e1: "final e⇩1"
show ?thesis
proof cases
assume "final e⇩2"
with WTrtFAssNT e1 show ?thesis
by(fastforce simp:final_def intro:RedFAssNull red_reds.FAssThrow1
red_reds.FAssThrow2 dest!:typeof_NT)
next
assume "¬ final e⇩2"
with WTrtFAssNT e1 show ?thesis
by (fastforce simp:final_def intro!:red_reds.FAssRed2 red_reds.FAssThrow1)
qed
next
assume "¬ final e⇩1"
with WTrtFAssNT show ?thesis by (fastforce intro:FAssRed1)
qed
next
case (WTrtCall E h e C M Ts T pns body Cs es Ts')
have wte: "P,E,h ⊢ e : Class C"
and "method":"P ⊢ C has least M = (Ts, T, pns, body) via Cs"
and wtes: "P,E,h ⊢ es [:] Ts'"and sub: "P ⊢ Ts' [≤] Ts"
and IHes: "⋀l. ⟦P ⊢ h √; P ⊢ E √; 𝒟s es ⌊dom l⌋; ¬ finals es⟧
⟹ ∃es' s'. P,E ⊢ ⟨es,(h,l)⟩ [→] ⟨es',s'⟩"
and hconf: "P ⊢ h √" and envconf:"P ⊢ E √"
and D: "𝒟 (e∙M(es)) ⌊dom l⌋" by fact+
show ?case
proof cases
assume final:"final e"
with wte show ?thesis
proof (rule final_refE)
fix r assume ref: "e = ref r"
show ?thesis
proof cases
assume es: "∃vs. es = map Val vs"
from ref obtain a Cs' where ref:"e = ref(a,Cs')" by (cases r) auto
with wte obtain D S where h:"h a = Some(D,S)" and suboD:"Subobjs P D Cs'"
and last:"last Cs' = C"
by (fastforce split:if_split_asm)
from wte ref h have subcls:"P ⊢ D ≼⇧* C" by -(drule mdc_leq_dyn_type,auto)
from "method" have has:"P ⊢ C has M = (Ts,T,pns,body) via Cs"
by(rule has_least_method_has_method)
from es obtain vs where vs:"es = map Val vs" by auto
obtain Cs'' Ts'' T' pns' body' where
ass:"P ⊢ (D,Cs'@⇩pCs) selects M = (Ts'',T',pns',body') via Cs'' ∧
length Ts'' = length pns' ∧ length vs = length pns' ∧ P ⊢ T' ≤ T"
proof (cases "∃Ts'' T' pns' body' Ds. P ⊢ D has least M = (Ts'',T',pns',body') via Ds")
case True
then obtain Ts'' T' pns' body' Cs''
where least:"P ⊢ D has least M = (Ts'',T',pns',body') via Cs''"
by auto
hence select:"P ⊢ (D,Cs'@⇩pCs) selects M = (Ts'',T',pns',body') via Cs''"
by(rule dyn_unique)
from subcls least wf has have "Ts = Ts''" and leq:"P ⊢ T' ≤ T"
by -(drule leq_method_subtypes,simp_all,blast)+
hence "length Ts = length Ts''" by (simp add:list_all2_iff)
with sub have "length Ts' = length Ts''" by (simp add:list_all2_iff)
with WTrts_same_length[OF wtes] vs have length:"length vs = length Ts''"
by simp
from has_least_wf_mdecl[OF wf least]
have lengthParams:"length Ts'' = length pns'" by (simp add:wf_mdecl_def)
with length have "length vs = length pns'" by simp
with select lengthParams leq show ?thesis using that by blast
next
case False
hence non_dyn:"∀Ts'' T' pns' body' Ds.
¬ P ⊢ D has least M = (Ts'',T',pns',body') via Ds" by auto
from suboD last have path:"P ⊢ Path D to C via Cs'"
by(simp add:path_via_def)
from "method" have notempty:"Cs ≠ []"
by(fastforce intro!:Subobjs_nonempty
simp:LeastMethodDef_def MethodDefs_def)
from suboD have "class": "is_class P D" by(rule Subobjs_isClass)
from suboD last have path:"P ⊢ Path D to C via Cs'"
by(simp add:path_via_def)
with "method" wf have "P ⊢ D has M = (Ts,T,pns,body) via Cs'@⇩pCs"
by(auto intro:has_path_has has_least_method_has_method)
with "class" wf obtain Cs'' Ts'' T' pns' body' where overrider:
"P ⊢ (D,Cs'@⇩pCs) has overrider M = (Ts'',T',pns',body') via Cs''"
by(auto dest!:class_wf simp:is_class_def wf_cdecl_def,blast)
with non_dyn
have select:"P ⊢ (D,Cs'@⇩pCs) selects M = (Ts'',T',pns',body') via Cs''"
by-(rule dyn_ambiguous,simp_all)
from notempty have eq:"(Cs' @⇩p Cs) @⇩p [last Cs] = (Cs' @⇩p Cs)"
by(rule appendPath_append_last)
from "method" wf
have "P ⊢ last Cs has least M = (Ts,T,pns,body) via [last Cs]"
by(auto dest:Subobj_last_isClass intro:Subobjs_Base subobjs_rel
simp:LeastMethodDef_def MethodDefs_def)
with notempty
have "P ⊢ last(Cs'@⇩pCs) has least M = (Ts,T,pns,body) via [last Cs]"
by -(drule_tac Cs'="Cs'" in appendPath_last,simp)
with overrider wf eq
have "(Cs'',(Ts'',T',pns',body')) ∈ MinimalMethodDefs P D M"
and "P,D ⊢ Cs'' ⊑ Cs'@⇩pCs"
by(auto simp:FinalOverriderMethodDef_def OverriderMethodDefs_def)
(drule wf_sees_method_fun,auto)
with subcls wf notempty has path have "Ts = Ts''" and leq:"P ⊢ T' ≤ T"
by -(drule leq_methods_subtypes,simp_all,blast)+
hence "length Ts = length Ts''" by (simp add:list_all2_iff)
with sub have "length Ts' = length Ts''" by (simp add:list_all2_iff)
with WTrts_same_length[OF wtes] vs have length:"length vs = length Ts''"
by simp
from select_method_wf_mdecl[OF wf select]
have lengthParams:"length Ts'' = length pns'" by (simp add:wf_mdecl_def)
with length have "length vs = length pns'" by simp
with select lengthParams leq show ?thesis using that by blast
qed
obtain new_body where "case T of Class D ⇒
new_body = ⦇D⦈blocks(this#pns',Class(last Cs'')#Ts'',Ref(a,Cs'')#vs,body')
| _ ⇒ new_body = blocks(this#pns',Class(last Cs'')#Ts'',Ref(a,Cs'')#vs,body')"
by(cases T) auto
with h "method" last ass ref vs
show ?thesis by (auto intro!:exI RedCall)
next
assume "¬(∃vs. es = map Val vs)"
hence not_all_Val: "¬(∀e ∈ set es. ∃v. e = Val v)"
by(simp add:ex_map_conv)
let ?ves = "takeWhile (λe. ∃v. e = Val v) es"
let ?rest = "dropWhile (λe. ∃v. e = Val v) es"
let ?ex = "hd ?rest" let ?rst = "tl ?rest"
from not_all_Val have nonempty: "?rest ≠ []" by auto
hence es: "es = ?ves @ ?ex # ?rst" by simp
have "∀e ∈ set ?ves. ∃v. e = Val v" by(fastforce dest:set_takeWhileD)
then obtain vs where ves: "?ves = map Val vs"
using ex_map_conv by blast
show ?thesis
proof cases
assume "final ?ex"
moreover from nonempty have "¬(∃v. ?ex = Val v)"
by(auto simp:neq_Nil_conv simp del:dropWhile_eq_Nil_conv)
(simp add:dropWhile_eq_Cons_conv)
ultimately obtain r' where ex_Throw: "?ex = Throw r'"
by(fast elim!:finalE)
show ?thesis using ref es ex_Throw ves
by(fastforce intro:red_reds.CallThrowParams)
next
assume not_fin: "¬ final ?ex"
have "finals es = finals(?ves @ ?ex # ?rst)" using es
by(rule arg_cong)
also have "… = finals(?ex # ?rst)" using ves by simp
finally have "finals es = finals(?ex # ?rst)" .
hence "¬ finals es" using not_finals_ConsI[OF not_fin] by blast
thus ?thesis using ref D IHes[OF hconf envconf]
by(fastforce intro!:CallParams)
qed
qed
next
fix r assume "e = Throw r"
with WTrtCall.prems show ?thesis by(fast intro!:red_reds.CallThrowObj)
qed
next
assume "¬ final e"
with WTrtCall show ?thesis by simp (blast intro!:CallObj)
qed
next
case (WTrtStaticCall E h e C' C M Ts T pns body Cs es Ts')
have wte: "P,E,h ⊢ e : Class C'"
and path_unique:"P ⊢ Path C' to C unique"
and "method":"P ⊢ C has least M = (Ts, T, pns, body) via Cs"
and wtes: "P,E,h ⊢ es [:] Ts'"and sub: "P ⊢ Ts' [≤] Ts"
and IHes: "⋀l.
⟦P ⊢ h √; envconf P E; 𝒟s es ⌊dom l⌋; ¬ finals es⟧
⟹ ∃es' s'. P,E ⊢ ⟨es,(h,l)⟩ [→] ⟨es',s'⟩"
and hconf: "P ⊢ h √" and envconf:"envconf P E"
and D: "𝒟 (e∙(C::)M(es)) ⌊dom l⌋" by fact+
show ?case
proof cases
assume final:"final e"
with wte show ?thesis
proof (rule final_refE)
fix r assume ref: "e = ref r"
show ?thesis
proof cases
assume es: "∃vs. es = map Val vs"
from ref obtain a Cs' where ref:"e = ref(a,Cs')" by (cases r) auto
with wte have last:"last Cs' = C'"
by (fastforce split:if_split_asm)
with path_unique obtain Cs''
where path_via:"P ⊢ Path (last Cs') to C via Cs''"
by (auto simp add:path_via_def path_unique_def)
obtain Ds where Ds:"Ds = (Cs'@⇩pCs'')@⇩pCs" by simp
from es obtain vs where vs:"es = map Val vs" by auto
from sub have "length Ts' = length Ts" by (simp add:list_all2_iff)
with WTrts_same_length[OF wtes] vs have length:"length vs = length Ts"
by simp
from has_least_wf_mdecl[OF wf "method"]
have lengthParams:"length Ts = length pns" by (simp add:wf_mdecl_def)
with "method" last path_unique path_via Ds length ref vs show ?thesis
by (auto intro!:exI RedStaticCall)
next
assume "¬(∃vs. es = map Val vs)"
hence not_all_Val: "¬(∀e ∈ set es. ∃v. e = Val v)"
by(simp add:ex_map_conv)
let ?ves = "takeWhile (λe. ∃v. e = Val v) es"
let ?rest = "dropWhile (λe. ∃v. e = Val v) es"
let ?ex = "hd ?rest" let ?rst = "tl ?rest"
from not_all_Val have nonempty: "?rest ≠ []" by auto
hence es: "es = ?ves @ ?ex # ?rst" by simp
have "∀e ∈ set ?ves. ∃v. e = Val v" by(fastforce dest:set_takeWhileD)
then obtain vs where ves: "?ves = map Val vs"
using ex_map_conv by blast
show ?thesis
proof cases
assume "final ?ex"
moreover from nonempty have "¬(∃v. ?ex = Val v)"
by(auto simp:neq_Nil_conv simp del:dropWhile_eq_Nil_conv)
(simp add:dropWhile_eq_Cons_conv)
ultimately obtain r' where ex_Throw: "?ex = Throw r'"
by(fast elim!:finalE)
show ?thesis using ref es ex_Throw ves
by(fastforce intro:red_reds.CallThrowParams)
next
assume not_fin: "¬ final ?ex"
have "finals es = finals(?ves @ ?ex # ?rst)" using es
by(rule arg_cong)
also have "… = finals(?ex # ?rst)" using ves by simp
finally have "finals es = finals(?ex # ?rst)" .
hence "¬ finals es" using not_finals_ConsI[OF not_fin] by blast
thus ?thesis using ref D IHes[OF hconf envconf]
by(fastforce intro!:CallParams)
qed
qed
next
fix r assume "e = Throw r"
with WTrtStaticCall.prems show ?thesis by(fast intro!:red_reds.CallThrowObj)
qed
next
assume "¬ final e"
with WTrtStaticCall show ?thesis by simp (blast intro!:CallObj)
qed
next
case (WTrtCallNT E h e es Ts Copt M T)
show ?case
proof cases
assume "final e"
moreover
{ fix v assume e: "e = Val v"
hence "e = null" using WTrtCallNT by simp
have ?case
proof cases
assume "finals es"
moreover
{ fix vs assume "es = map Val vs"
with WTrtCallNT e have ?thesis by(fastforce intro: RedCallNull dest!:typeof_NT) }
moreover
{ fix vs a es' assume "es = map Val vs @ Throw a # es'"
with WTrtCallNT e have ?thesis by(fastforce intro: CallThrowParams) }
ultimately show ?thesis by(fastforce simp:finals_def)
next
assume "¬ finals es"
with WTrtCallNT e show ?thesis by(fastforce intro: CallParams)
qed
}
moreover
{ fix r assume "e = Throw r"
with WTrtCallNT have ?case by(fastforce intro: CallThrowObj) }
ultimately show ?thesis by(fastforce simp:final_def)
next
assume "¬ final e"
with WTrtCallNT show ?thesis by (fastforce intro:CallObj)
qed
next
case (WTrtInitBlock h v T' E V T e⇩2 T⇩2)
have IH2: "⋀l. ⟦P ⊢ h √; P ⊢ E(V ↦ T) √; 𝒟 e⇩2 ⌊dom l⌋; ¬ final e⇩2⟧
⟹ ∃e' s'. P,E(V ↦ T) ⊢ ⟨e⇩2,(h,l)⟩ → ⟨e',s'⟩"
and typeof:"P ⊢ typeof⇘h⇙ v = Some T'"
and type:"is_type P T" and sub:"P ⊢ T' ≤ T"
and hconf: "P ⊢ h √" and envconf:"P ⊢ E √"
and D: "𝒟 {V:T := Val v; e⇩2} ⌊dom l⌋" by fact+
from wf typeof type sub obtain v' where casts:"P ⊢ T casts v to v'"
by(auto dest:sub_casts)
show ?case
proof cases
assume fin:"final e⇩2"
with casts show ?thesis
by(fastforce elim:finalE intro:RedInitBlock red_reds.InitBlockThrow)
next
assume not_fin2: "¬ final e⇩2"
from D have D2: "𝒟 e⇩2 ⌊dom(l(V↦v'))⌋" by (auto simp:hyperset_defs)
from envconf type have "P ⊢ E(V ↦ T) √" by(auto simp:envconf_def)
from IH2[OF hconf this D2 not_fin2]
obtain h' l' e' where red2: "P,E(V ↦ T) ⊢ ⟨e⇩2,(h, l(V↦v'))⟩ → ⟨e',(h', l')⟩"
by auto
from red_lcl_incr[OF red2] have "V ∈ dom l'" by auto
with red2 casts show ?thesis by(fastforce intro:InitBlockRed)
qed
next
case (WTrtBlock E V T h e T')
have IH: "⋀l. ⟦P ⊢ h √; P ⊢ E(V ↦ T) √; 𝒟 e ⌊dom l⌋; ¬ final e⟧
⟹ ∃e' s'. P,E(V ↦ T) ⊢ ⟨e,(h,l)⟩ → ⟨e',s'⟩"
and unass: "¬ assigned V e" and type:"is_type P T"
and hconf: "P ⊢ h √" and envconf:"P ⊢ E √"
and D: "𝒟 {V:T; e} ⌊dom l⌋" by fact+
show ?case
proof cases
assume "final e"
thus ?thesis
proof (rule finalE)
fix v assume "e = Val v" with type show ?thesis by(fast intro:RedBlock)
next
fix r assume "e = Throw r"
with type show ?thesis by(fast intro:red_reds.BlockThrow)
qed
next
assume not_fin: "¬ final e"
from D have De: "𝒟 e ⌊dom(l(V:=None))⌋" by(simp add:hyperset_defs)
from envconf type have "P ⊢ E(V ↦ T) √" by(auto simp:envconf_def)
from IH[OF hconf this De not_fin]
obtain h' l' e' where red: "P,E(V ↦ T) ⊢ ⟨e,(h,l(V:=None))⟩ → ⟨e',(h',l')⟩"
by auto
show ?thesis
proof (cases "l' V")
assume "l' V = None"
with red unass show ?thesis by(blast intro: BlockRedNone)
next
fix v assume "l' V = Some v"
with red unass type show ?thesis by(blast intro: BlockRedSome)
qed
qed
next
case (WTrtSeq E h e⇩1 T⇩1 e⇩2 T⇩2)
show ?case
proof cases
assume "final e⇩1"
thus ?thesis
by(fast elim:finalE intro:intro:RedSeq red_reds.SeqThrow)
next
assume "¬ final e⇩1" with WTrtSeq show ?thesis
by simp (blast intro:SeqRed)
qed
next
case (WTrtCond E h e e⇩1 T e⇩2)
have wt: "P,E,h ⊢ e : Boolean" by fact
show ?case
proof cases
assume "final e"
thus ?thesis
proof (rule finalE)
fix v assume val: "e = Val v"
then obtain b where v: "v = Bool b" using wt by (fastforce dest:typeof_Boolean)
show ?thesis
proof (cases b)
case True with val v show ?thesis by(auto intro:RedCondT)
next
case False with val v show ?thesis by(auto intro:RedCondF)
qed
next
fix r assume "e = Throw r"
thus ?thesis by(fast intro:red_reds.CondThrow)
qed
next
assume "¬ final e" with WTrtCond show ?thesis
by simp (fast intro:CondRed)
qed
next
case WTrtWhile show ?case by(fast intro:RedWhile)
next
case (WTrtThrow E h e T' T)
show ?case
proof cases
assume "final e"
with WTrtThrow show ?thesis
by(fastforce simp:final_def is_refT_def
intro:red_reds.ThrowThrow red_reds.RedThrowNull
dest!:typeof_NT typeof_Class_Subo)
next
assume "¬ final e"
with WTrtThrow show ?thesis by simp (blast intro:ThrowRed)
qed
next
case WTrtNil thus ?case by simp
next
case (WTrtCons E h e T es Ts)
have IHe: "⋀l. ⟦P ⊢ h √; P ⊢ E √; 𝒟 e ⌊dom l⌋; ¬ final e⟧
⟹ ∃e' s'. P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',s'⟩"
and IHes: "⋀l. ⟦P ⊢ h √; P ⊢ E √; 𝒟s es ⌊dom l⌋; ¬ finals es⟧
⟹ ∃es' s'. P,E ⊢ ⟨es,(h,l)⟩ [→] ⟨es',s'⟩"
and hconf: "P ⊢ h √" and envconf:"P ⊢ E √"
and D: "𝒟s (e#es) ⌊dom l⌋"
and not_fins: "¬ finals(e # es)" by fact+
have De: "𝒟 e ⌊dom l⌋" and Des: "𝒟s es (⌊dom l⌋ ⊔ 𝒜 e)"
using D by auto
show ?case
proof cases
assume "final e"
thus ?thesis
proof (rule finalE)
fix v assume e: "e = Val v"
hence Des': "𝒟s es ⌊dom l⌋" using De Des by auto
have not_fins_tl: "¬ finals es" using not_fins e by simp
show ?thesis using e IHes[OF hconf envconf Des' not_fins_tl]
by (blast intro!:ListRed2)
next
fix r assume "e = Throw r"
hence False using not_fins by simp
thus ?thesis ..
qed
next
assume "¬ final e"
from IHe[OF hconf envconf De this] show ?thesis by(fast intro!:ListRed1)
qed
qed
end
Theory HeapExtension
section ‹Heap Extension›
theory HeapExtension
imports Progress
begin
subsection ‹The Heap Extension›
definition hext :: "heap ⇒ heap ⇒ bool" ("_ ⊴ _" [51,51] 50) where
"h ⊴ h' ≡ ∀a C S. h a = Some(C,S) ⟶ (∃S'. h' a = Some(C,S'))"
lemma hextI: "∀a C S. h a = Some(C,S) ⟶ (∃S'. h' a = Some(C,S')) ⟹ h ⊴ h'"
apply (unfold hext_def)
apply auto
done
lemma hext_objD: "⟦ h ⊴ h'; h a = Some(C,S) ⟧ ⟹ ∃S'. h' a = Some(C,S')"
apply (unfold hext_def)
apply (force)
done
lemma hext_refl [iff]: "h ⊴ h"
apply (rule hextI)
apply (fast)
done
lemma hext_new [simp]: "h a = None ⟹ h ⊴ h(a↦x)"
apply (rule hextI)
apply (auto simp:fun_upd_apply)
done
lemma hext_trans: "⟦ h ⊴ h'; h' ⊴ h'' ⟧ ⟹ h ⊴ h''"
apply (rule hextI)
apply (fast dest: hext_objD)
done
lemma hext_upd_obj: "h a = Some (C,S) ⟹ h ⊴ h(a↦(C,S'))"
apply (rule hextI)
apply (auto simp:fun_upd_apply)
done
subsection ‹‹⊴› and preallocated›
lemma preallocated_hext:
"⟦ preallocated h; h ⊴ h' ⟧ ⟹ preallocated h'"
by (simp add: preallocated_def hext_def)
lemmas preallocated_upd_obj = preallocated_hext [OF _ hext_upd_obj]
lemmas preallocated_new = preallocated_hext [OF _ hext_new]
subsection ‹‹⊴› in Small- and BigStep›
lemma red_hext_incr: "P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',(h',l')⟩ ⟹ h ⊴ h'"
and reds_hext_incr: "P,E ⊢ ⟨es,(h,l)⟩ [→] ⟨es',(h',l')⟩ ⟹ h ⊴ h'"
proof(induct rule:red_reds_inducts)
case RedNew thus ?case
by(fastforce dest:new_Addr_SomeD simp:hext_def split:if_splits)
next
case RedFAss thus ?case by(simp add:hext_def split:if_splits)
qed simp_all
lemma step_hext_incr: "P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ⟹ hp s ⊴ hp s'"
proof(induct rule:converse_rtrancl_induct2)
case refl thus ?case by(rule hext_refl)
next
case (step e s e'' s'')
have Red:"((e, s), e'', s'') ∈ Red P E"
and hext:"hp s'' ⊴ hp s'" by fact+
from Red have "P,E ⊢ ⟨e,s⟩ → ⟨e'',s''⟩" by simp
hence "hp s ⊴ hp s''"
by(cases s,cases s'')(auto dest:red_hext_incr)
with hext show ?case by-(rule hext_trans)
qed
lemma steps_hext_incr: "P,E ⊢ ⟨es,s⟩ [→]* ⟨es',s'⟩ ⟹ hp s ⊴ hp s'"
proof(induct rule:converse_rtrancl_induct2)
case refl thus ?case by(rule hext_refl)
next
case (step es s es'' s'')
have Reds:"((es, s), es'', s'') ∈ Reds P E"
and hext:"hp s'' ⊴ hp s'" by fact+
from Reds have "P,E ⊢ ⟨es,s⟩ [→] ⟨es'',s''⟩" by simp
hence "hp s ⊴ hp s''"
by(cases s,cases s'',auto dest:reds_hext_incr)
with hext show ?case by-(rule hext_trans)
qed
lemma eval_hext: "P,E ⊢ ⟨e,(h,l)⟩ ⇒ ⟨e',(h',l')⟩ ⟹ h ⊴ h'"
and evals_hext: "P,E ⊢ ⟨es,(h,l)⟩ [⇒] ⟨es',(h',l')⟩ ⟹ h ⊴ h'"
proof (induct rule:eval_evals_inducts)
case New thus ?case
by(fastforce intro!: hext_new intro:someI simp:new_Addr_def
split:if_split_asm simp del:fun_upd_apply)
next
case FAss thus ?case
by(auto simp:sym[THEN hext_upd_obj] simp del:fun_upd_apply
elim!: hext_trans)
qed (auto elim!: hext_trans)
subsection ‹‹⊴› and conformance›
lemma conf_hext: "h ⊴ h' ⟹ P,h ⊢ v :≤ T ⟹ P,h' ⊢ v :≤ T"
by(cases T)(induct v,auto dest: hext_objD split:if_split_asm)+
lemma confs_hext: "P,h ⊢ vs [:≤] Ts ⟹ h ⊴ h' ⟹ P,h' ⊢ vs [:≤] Ts"
by (erule list_all2_mono, erule conf_hext, assumption)
lemma fconf_hext: "⟦ P,h ⊢ fs (:≤) E; h ⊴ h' ⟧ ⟹ P,h' ⊢ fs (:≤) E"
apply (unfold fconf_def)
apply (fast elim: conf_hext)
done
lemmas fconf_upd_obj = fconf_hext [OF _ hext_upd_obj]
lemmas fconf_new = fconf_hext [OF _ hext_new]
lemma oconf_hext: "P,h ⊢ obj √ ⟹ h ⊴ h' ⟹ P,h' ⊢ obj √"
apply (auto simp:oconf_def)
apply (erule allE)
apply (erule_tac x="Cs" in allE)
apply (erule_tac x="fs'" in allE)
apply (fastforce elim:fconf_hext)
done
lemmas oconf_new = oconf_hext [OF _ hext_new]
lemmas oconf_upd_obj = oconf_hext [OF _ hext_upd_obj]
lemma hconf_new: "⟦ P ⊢ h √; h a = None; P,h ⊢ obj √ ⟧ ⟹ P ⊢ h(a↦obj) √"
by (unfold hconf_def) (auto intro: oconf_new preallocated_new)
lemma "⟦P ⊢ h √; h' = h(a ↦ (C, Collect (init_obj P C))); h a = None; wf_prog wf_md P⟧
⟹ P ⊢ h' √"
apply (simp add:hconf_def oconf_def)
apply auto
apply (rule_tac x="init_class_fieldmap P (last Cs)" in exI)
apply (rule init_obj.intros)
apply assumption
apply (erule init_obj.cases)
apply clarsimp
apply (erule init_obj.cases)
apply clarsimp
apply (erule_tac x="a" in allE)
apply clarsimp
apply (erule init_obj.cases)
apply simp
apply (erule_tac x="a" in allE)
apply clarsimp
apply (erule init_obj.cases)
apply clarsimp
apply (drule Subobj_last_isClass)
apply simp
apply (auto simp:is_class_def)
apply (rule fconf_init_fields)
apply auto
apply (erule_tac x="aa" in allE)
apply (erule_tac x="aaa" in allE)
apply (erule_tac x="b" in allE)
apply clarsimp
apply (rotate_tac -1)
apply (erule_tac x="Cs" in allE)
apply (erule_tac x="fs'" in allE)
apply clarsimp thm fconf_new
apply (erule fconf_new)
apply simp
apply (rule preallocated_new)
apply simp_all
done
lemma hconf_upd_obj:
"⟦ P ⊢ h√; h a = Some(C,S); P,h ⊢ (C,S')√ ⟧ ⟹ P ⊢ h(a↦(C,S'))√"
by (unfold hconf_def) (auto intro: oconf_upd_obj preallocated_upd_obj)
lemma lconf_hext: "⟦ P,h ⊢ l (:≤)⇩w E; h ⊴ h' ⟧ ⟹ P,h' ⊢ l (:≤)⇩w E"
apply (unfold lconf_def)
apply (fast elim: conf_hext)
done
subsection ‹‹⊴› in the runtime type system›
lemma hext_typeof_mono: "⟦ h ⊴ h'; P ⊢ typeof⇘h⇙ v = Some T ⟧ ⟹ P ⊢ typeof⇘h'⇙ v = Some T"
apply(cases v)
apply simp
apply simp
apply simp
apply simp
apply(fastforce simp:hext_def)
done
lemma WTrt_hext_mono: "P,E,h ⊢ e : T ⟹ (⋀h'. h ⊴ h' ⟹ P,E,h' ⊢ e : T)"
and WTrts_hext_mono: "P,E,h ⊢ es [:] Ts ⟹ (⋀h'. h ⊴ h' ⟹ P,E,h' ⊢ es [:] Ts)"
apply(induct rule: WTrt_inducts)
apply(simp add: WTrtNew)
apply(fastforce intro: WTrtDynCast)
apply(fastforce intro: WTrtStaticCast)
apply(fastforce simp: WTrtVal dest:hext_typeof_mono)
apply(simp add: WTrtVar)
apply(fastforce simp add: WTrtBinOp)
apply(fastforce simp add: WTrtLAss)
apply(fastforce simp: WTrtFAcc del:WTrt_WTrts.intros WTrt_elim_cases)
apply(simp add: WTrtFAccNT)
apply(fastforce simp: WTrtFAss del:WTrt_WTrts.intros WTrt_elim_cases)
apply(fastforce simp: WTrtFAssNT del:WTrt_WTrts.intros WTrt_elim_cases)
apply(fastforce simp: WTrtCall del:WTrt_WTrts.intros WTrt_elim_cases)
apply(fastforce simp: WTrtStaticCall del:WTrt_WTrts.intros WTrt_elim_cases)
apply(fastforce simp: WTrtCallNT del:WTrt_WTrts.intros WTrt_elim_cases)
apply(fastforce)
apply(fastforce simp add: WTrtSeq)
apply(fastforce simp add: WTrtCond)
apply(fastforce simp add: WTrtWhile)
apply(fastforce simp add: WTrtThrow)
apply(simp add: WTrtNil)
apply(simp add: WTrtCons)
done
end
Theory TypeSafe
section ‹Type Safety Proof›
theory TypeSafe
imports HeapExtension CWellForm
begin
subsection‹Basic preservation lemmas›
lemma assumes wf:"wwf_prog P" and casts:"P ⊢ T casts v to v'"
and typeof:"P ⊢ typeof⇘h⇙ v = Some T'" and leq:"P ⊢ T' ≤ T"
shows casts_conf:"P,h ⊢ v' :≤ T"
proof -
{ fix a' C Cs S'
assume leq:"P ⊢ Class (last Cs) ≤ T" and subo:"Subobjs P C Cs"
and casts':"P ⊢ T casts Ref (a',Cs) to v'" and h:"h a' = Some(C,S')"
from subo wf have "is_class P (last Cs)" by(fastforce intro:Subobj_last_isClass)
with leq wf obtain C' where T:"T = Class C'"
and path_unique:"P ⊢ Path (last Cs) to C' unique"
by(auto dest:Class_widen)
from path_unique obtain Cs' where path_via:"P ⊢ Path (last Cs) to C' via Cs'"
by(auto simp:path_via_def path_unique_def)
with T path_unique casts' have v':"v' = Ref (a',Cs@⇩pCs')"
by -(erule casts_to.cases,auto simp:path_unique_def path_via_def)
from subo path_via wf have "Subobjs P C (Cs@⇩pCs')"
and "last (Cs@⇩pCs') = C'"
apply(auto intro:Subobjs_appendPath simp:path_via_def)
apply(drule_tac Cs="Cs'" in Subobjs_nonempty)
by(rule sym[OF appendPath_last])
with T h v' have ?thesis by auto }
with casts typeof wf typeof leq show ?thesis
by(cases v,auto elim:casts_to.cases split:if_split_asm)
qed
theorem assumes wf:"wwf_prog P"
shows red_preserves_hconf:
"P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',(h',l')⟩ ⟹ (⋀T. ⟦ P,E,h ⊢ e : T; P ⊢ h √ ⟧ ⟹ P ⊢ h' √)"
and reds_preserves_hconf:
"P,E ⊢ ⟨es,(h,l)⟩ [→] ⟨es',(h',l')⟩ ⟹ (⋀Ts. ⟦ P,E,h ⊢ es [:] Ts; P ⊢ h √ ⟧ ⟹ P ⊢ h' √)"
proof (induct rule:red_reds_inducts)
case (RedNew h a h' C E l)
have new: "new_Addr h = Some a" and h':"h' = h(a ↦ (C, Collect (init_obj P C)))"
and hconf:"P ⊢ h √" and wt_New:"P,E,h ⊢ new C : T" by fact+
from new have None: "h a = None" by(rule new_Addr_SomeD)
with wf have oconf:"P,h ⊢ (C, Collect (init_obj P C)) √"
apply (auto simp:oconf_def)
apply (rule_tac x="init_class_fieldmap P (last Cs)" in exI)
by (fastforce intro:init_obj.intros fconf_init_fields
elim: init_obj.cases dest!:Subobj_last_isClass simp:is_class_def)+
thus ?case using h' None by(fast intro: hconf_new[OF hconf])
next
case (RedFAss h a D S Cs' F T Cs v v' Ds fs' E l T')
let ?fs' = "fs'(F ↦ v')"
let ?S' = "insert (Ds, ?fs') (S - {(Ds, fs')})"
have ha:"h a = Some(D,S)" and hconf:"P ⊢ h √"
and field:"P ⊢ last Cs' has least F:T via Cs"
and casts:"P ⊢ T casts v to v'"
and Ds:"Ds = Cs' @⇩p Cs" and S:"(Ds,fs') ∈ S"
and wte:"P,E,h ⊢ ref(a,Cs')∙F{Cs} := Val v : T'" by fact+
from wte have "P ⊢ last Cs' has least F:T' via Cs" by (auto split:if_split_asm)
with field have eq:"T = T'" by (rule sees_field_fun)
with casts wte wf have conf:"P,h ⊢ v' :≤ T'"
by(auto intro:casts_conf)
from hconf ha have oconf:"P,h ⊢ (D,S) √" by (fastforce simp:hconf_def)
with S have suboD:"Subobjs P D Ds" by (fastforce simp:oconf_def)
from field obtain Bs fs ms
where subo:"Subobjs P (last Cs') Cs"
and "class": "class P (last Cs) = Some(Bs,fs,ms)"
and map:"map_of fs F = Some T"
by (auto simp:LeastFieldDecl_def FieldDecls_def)
from Ds subo have last:"last Cs = last Ds"
by(fastforce dest:Subobjs_nonempty intro:appendPath_last simp:appendPath_last)
with "class" have classDs:"class P (last Ds) = Some(Bs,fs,ms)" by simp
with S suboD oconf have "P,h ⊢ fs' (:≤) map_of fs"
apply (auto simp:oconf_def)
apply (erule allE)
apply (erule_tac x="Ds" in allE)
apply (erule_tac x="fs'" in allE)
apply clarsimp
done
with map conf eq have fconf:"P,h ⊢ fs'(F ↦ v') (:≤) map_of fs"
by (simp add:fconf_def)
from oconf have "∀Cs fs'. (Cs,fs') ∈ S ⟶ Subobjs P D Cs ∧
(∃fs Bs ms. class P (last Cs) = Some (Bs,fs,ms) ∧
P,h ⊢ fs' (:≤) map_of fs)"
by(simp add:oconf_def)
with suboD classDs fconf
have oconf':"∀Cs fs'. (Cs,fs') ∈ ?S' ⟶ Subobjs P D Cs ∧
(∃fs Bs ms. class P (last Cs) = Some (Bs,fs,ms) ∧
P,h ⊢ fs' (:≤) map_of fs)"
by auto
from oconf have all:"∀Cs. Subobjs P D Cs ⟶ (∃!fs'. (Cs,fs') ∈ S)"
by(simp add:oconf_def)
with S have "∀Cs. Subobjs P D Cs ⟶ (∃!fs'. (Cs,fs') ∈ ?S')" by blast
with oconf' have oconf':"P,h ⊢ (D,?S') √"
by (simp add:oconf_def)
with hconf ha show ?case by (rule hconf_upd_obj)
next
case (CallObj E e h l e' h' l' Copt M es) thus ?case by (cases Copt) auto
next
case (CallParams E es h l es' h' l' v Copt M) thus ?case by (cases Copt) auto
next
case (RedCallNull E Copt M vs h l) thus ?case by (cases Copt) auto
qed auto
theorem assumes wf:"wwf_prog P"
shows red_preserves_lconf:
"P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',(h',l')⟩ ⟹
(⋀T. ⟦ P,E,h ⊢ e:T; P,h ⊢ l (:≤)⇩w E; P ⊢ E √ ⟧ ⟹ P,h' ⊢ l' (:≤)⇩w E)"
and reds_preserves_lconf:
"P,E ⊢ ⟨es,(h,l)⟩ [→] ⟨es',(h',l')⟩ ⟹
(⋀Ts. ⟦ P,E,h ⊢ es[:]Ts; P,h ⊢ l (:≤)⇩w E; P ⊢ E √ ⟧ ⟹ P,h' ⊢ l' (:≤)⇩w E)"
proof(induct rule:red_reds_inducts)
case RedNew thus ?case
by(fast intro:lconf_hext red_hext_incr[OF red_reds.RedNew])
next
case (RedLAss E V T v v' h l T')
have casts:"P ⊢ T casts v to v'" and env:"E V = Some T"
and wt:"P,E,h ⊢ V:=Val v : T'" and lconf:"P,h ⊢ l (:≤)⇩w E" by fact+
from wt env have eq:"T = T'" by auto
with casts wt wf have conf:"P,h ⊢ v' :≤ T'"
by(auto intro:casts_conf)
with lconf env eq show ?case
by (simp del:fun_upd_apply)(erule lconf_upd,simp_all)
next
case RedFAss thus ?case
by(auto intro:lconf_hext red_hext_incr[OF red_reds.RedFAss]
simp del:fun_upd_apply)
next
case (BlockRedNone E V T e h l e' h' l' T')
have red:"P,E(V ↦ T) ⊢ ⟨e,(h, l(V := None))⟩ → ⟨e',(h', l')⟩"
and IH: "⋀T''. ⟦ P,E(V ↦ T),h ⊢ e : T''; P,h ⊢ l(V:=None) (:≤)⇩w E(V ↦ T);
envconf P (E(V ↦ T)) ⟧
⟹ P,h' ⊢ l' (:≤)⇩w E(V ↦ T)"
and lconf: "P,h ⊢ l (:≤)⇩w E" and wte: "P,E,h ⊢ {V:T; e} : T'"
and envconf:"envconf P E" by fact+
from lconf_hext[OF lconf red_hext_incr[OF red]]
have lconf':"P,h' ⊢ l (:≤)⇩w E" .
from wte have wte':"P,E(V↦T),h ⊢ e : T'" and type:"is_type P T"
by (auto elim:WTrt.cases)
from envconf type have envconf':"envconf P (E(V ↦ T))"
by(auto simp:envconf_def)
from lconf have "P,h ⊢ (l(V := None)) (:≤)⇩w E(V↦T)"
by (simp add:lconf_def fun_upd_apply)
from IH[OF wte' this envconf'] have "P,h' ⊢ l' (:≤)⇩w E(V↦T)" .
with lconf' show ?case
by (fastforce simp:lconf_def fun_upd_apply split:if_split_asm)
next
case (BlockRedSome E V T e h l e' h' l' v T')
have red:"P,E(V ↦ T) ⊢ ⟨e,(h, l(V := None))⟩ → ⟨e',(h', l')⟩"
and IH: "⋀T''. ⟦ P,E(V ↦ T),h ⊢ e : T''; P,h ⊢ l(V:=None) (:≤)⇩w E(V ↦ T);
envconf P (E(V ↦ T)) ⟧
⟹ P,h' ⊢ l' (:≤)⇩w E(V ↦ T)"
and lconf: "P,h ⊢ l (:≤)⇩w E" and wte: "P,E,h ⊢ {V:T; e} : T'"
and envconf:"envconf P E" by fact+
from lconf_hext[OF lconf red_hext_incr[OF red]]
have lconf':"P,h' ⊢ l (:≤)⇩w E" .
from wte have wte':"P,E(V↦T),h ⊢ e : T'" and type:"is_type P T"
by (auto elim:WTrt.cases)
from envconf type have envconf':"envconf P (E(V ↦ T))"
by(auto simp:envconf_def)
from lconf have "P,h ⊢ (l(V := None)) (:≤)⇩w E(V↦T)"
by (simp add:lconf_def fun_upd_apply)
from IH[OF wte' this envconf'] have "P,h' ⊢ l' (:≤)⇩w E(V↦T)" .
with lconf' show ?case
by (fastforce simp:lconf_def fun_upd_apply split:if_split_asm)
next
case (InitBlockRed E V T e h l v' e' h' l' v'' v T')
have red: "P,E(V ↦ T) ⊢ ⟨e, (h, l(V↦v'))⟩ → ⟨e',(h', l')⟩"
and IH: "⋀T''. ⟦ P,E(V ↦ T),h ⊢ e : T''; P,h ⊢ l(V ↦ v') (:≤)⇩w E(V ↦ T);
envconf P (E(V ↦ T)) ⟧
⟹ P,h' ⊢ l' (:≤)⇩w E(V ↦ T)"
and lconf:"P,h ⊢ l (:≤)⇩w E" and l':"l' V = Some v''"
and wte:"P,E,h ⊢ {V:T; V:=Val v;; e} : T'"
and casts:"P ⊢ T casts v to v'" and envconf:"envconf P E" by fact+
from lconf_hext[OF lconf red_hext_incr[OF red]]
have lconf':"P,h' ⊢ l (:≤)⇩w E" .
from wte obtain T'' where wte':"P,E(V↦T),h ⊢ e : T'"
and wt:"P,E(V ↦ T),h ⊢ V:=Val v : T''"
and type:"is_type P T"
by (auto elim:WTrt.cases)
from envconf type have envconf':"envconf P (E(V ↦ T))"
by(auto simp:envconf_def)
from wt have "T'' = T" by auto
with wf casts wt have "P,h ⊢ v' :≤ T"
by(auto intro:casts_conf)
with lconf have "P,h ⊢ l(V ↦ v') (:≤)⇩w E(V↦T)"
by -(rule lconf_upd2)
from IH[OF wte' this envconf'] have "P,h' ⊢ l' (:≤)⇩w E(V ↦ T)" .
with lconf' show ?case
by (fastforce simp:lconf_def fun_upd_apply split:if_split_asm)
next
case (CallObj E e h l e' h' l' Copt M es) thus ?case by (cases Copt) auto
next
case (CallParams E es h l es' h' l' v Copt M) thus ?case by (cases Copt) auto
next
case (RedCallNull E Copt M vs h l) thus ?case by (cases Copt) auto
qed auto
text‹Preservation of definite assignment more complex and requires a
few lemmas first.›
lemma [iff]: "⋀A. ⟦ length Vs = length Ts; length vs = length Ts⟧ ⟹
𝒟 (blocks (Vs,Ts,vs,e)) A = 𝒟 e (A ⊔ ⌊set Vs⌋)"
apply(induct Vs Ts vs e rule:blocks_old_induct)
apply(simp_all add:hyperset_defs)
done
lemma red_lA_incr: "P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',(h',l')⟩ ⟹ ⌊dom l⌋ ⊔ 𝒜 e ⊑ ⌊dom l'⌋ ⊔ 𝒜 e'"
and reds_lA_incr: "P,E ⊢ ⟨es,(h,l)⟩ [→] ⟨es',(h',l')⟩ ⟹ ⌊dom l⌋ ⊔ 𝒜s es ⊑ ⌊dom l'⌋ ⊔ 𝒜s es'"
apply (induct rule:red_reds_inducts)
apply (simp_all del: fun_upd_apply add: hyperset_defs)
apply blast
apply blast
apply blast
apply blast
apply blast
apply blast
apply blast
apply auto
done
text‹Now preservation of definite assignment.›
lemma assumes wf: "wf_C_prog P"
shows red_preserves_defass:
"P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',(h',l')⟩ ⟹ 𝒟 e ⌊dom l⌋ ⟹ 𝒟 e' ⌊dom l'⌋"
and "P,E ⊢ ⟨es,(h,l)⟩ [→] ⟨es',(h',l')⟩ ⟹ 𝒟s es ⌊dom l⌋ ⟹ 𝒟s es' ⌊dom l'⌋"
proof (induct rule:red_reds_inducts)
case BinOpRed1 thus ?case by (auto elim!: D_mono[OF red_lA_incr])
next
case FAssRed1 thus ?case by (auto elim!: D_mono[OF red_lA_incr])
next
case CallObj thus ?case by (auto elim!: Ds_mono[OF red_lA_incr])
next
case (RedCall h l a C S Cs M Ts' T' pns' body' Ds Ts T pns body Cs'
vs bs new_body E)
thus ?case
apply (auto dest!:select_method_wf_mdecl[OF wf] simp:wf_mdecl_def elim!:D_mono')
apply(cases T') apply auto
by(rule_tac A="⌊insert this (set pns)⌋" in D_mono,clarsimp simp:hyperset_defs,
assumption)+
next
case RedStaticCall thus ?case
apply (auto dest!:has_least_wf_mdecl[OF wf] simp:wf_mdecl_def elim!:D_mono')
by(auto simp:hyperset_defs)
next
case InitBlockRed thus ?case
by(auto simp:hyperset_defs elim!:D_mono' simp del:fun_upd_apply)
next
case BlockRedNone thus ?case
by(auto simp:hyperset_defs elim!:D_mono' simp del:fun_upd_apply)
next
case BlockRedSome thus ?case
by(auto simp:hyperset_defs elim!:D_mono' simp del:fun_upd_apply)
next
case SeqRed thus ?case by (auto elim!: D_mono[OF red_lA_incr])
next
case CondRed thus ?case by (auto elim!: D_mono[OF red_lA_incr])
next
case RedWhile thus ?case by(auto simp:hyperset_defs elim!:D_mono')
next
case ListRed1 thus ?case by (auto elim!: Ds_mono[OF red_lA_incr])
qed (auto simp:hyperset_defs)
text‹Combining conformance of heap and local variables:›
definition sconf :: "prog ⇒ env ⇒ state ⇒ bool" ("_,_ ⊢ _ √" [51,51,51]50) where
"P,E ⊢ s √ ≡ let (h,l) = s in P ⊢ h √ ∧ P,h ⊢ l (:≤)⇩w E ∧ P ⊢ E √"
lemma red_preserves_sconf:
"⟦ P,E ⊢ ⟨e,s⟩ → ⟨e',s'⟩; P,E,hp s ⊢ e : T; P,E ⊢ s √; wwf_prog P⟧
⟹ P,E ⊢ s' √"
by(fastforce intro:red_preserves_hconf red_preserves_lconf
simp add:sconf_def)
lemma reds_preserves_sconf:
"⟦ P,E ⊢ ⟨es,s⟩ [→] ⟨es',s'⟩; P,E,hp s ⊢ es [:] Ts; P,E ⊢ s √; wwf_prog P⟧
⟹ P,E ⊢ s' √"
by(fastforce intro:reds_preserves_hconf reds_preserves_lconf
simp add:sconf_def)
subsection "Subject reduction"
lemma wt_blocks:
"⋀E. ⟦ length Vs = length Ts; length vs = length Ts;
∀T' ∈ set Ts. is_type P T'⟧ ⟹
(P,E,h ⊢ blocks(Vs,Ts,vs,e) : T) =
(P,E(Vs[↦]Ts),h ⊢ e:T ∧
(∃Ts'. map (P ⊢ typeof⇘h⇙) vs = map Some Ts' ∧ P ⊢ Ts' [≤] Ts))"
proof(induct Vs Ts vs e rule:blocks_old_induct)
case (5 V Vs T' Ts v vs e)
have length:"length (V#Vs) = length (T'#Ts)" "length (v#vs) = length (T'#Ts)"
and type:"∀S ∈ set (T'#Ts). is_type P S"
and IH:"⋀E. ⟦length Vs = length Ts; length vs = length Ts;
∀S ∈ set Ts. is_type P S⟧
⟹ (P,E,h ⊢ blocks (Vs, Ts, vs, e) : T) =
(P,E(Vs [↦] Ts),h ⊢ e : T ∧
(∃Ts'. map P ⊢ typeof⇘h⇙ vs = map Some Ts' ∧ P ⊢ Ts' [≤] Ts))" by fact+
from type have typeT':"is_type P T'" and type':"∀S ∈ set Ts. is_type P S"
by simp_all
from length have "length Vs = length Ts" "length vs = length Ts"
by simp_all
from IH[OF this type'] have eq:"(P,E(V ↦ T'),h ⊢ blocks (Vs,Ts,vs,e) : T) =
(P,E(V ↦ T')(Vs [↦] Ts),h ⊢ e : T ∧
(∃Ts'. map P ⊢ typeof⇘h⇙ vs = map Some Ts' ∧ P ⊢ Ts' [≤] Ts))" .
show ?case
proof(rule iffI)
assume "P,E,h ⊢ blocks (V#Vs,T'#Ts,v#vs,e) : T"
then have wt:"P,E(V ↦ T'),h ⊢ V:=Val v : T'"
and blocks:"P,E(V ↦ T'),h ⊢ blocks (Vs,Ts,vs,e) : T" by auto
from blocks eq obtain Ts' where wte:"P,E(V ↦ T')(Vs [↦] Ts),h ⊢ e : T"
and typeof:"map P ⊢ typeof⇘h⇙ vs = map Some Ts'" and subs:"P ⊢ Ts' [≤] Ts"
by auto
from wt obtain T'' where "P ⊢ typeof⇘h⇙ v = Some T''" and "P ⊢ T'' ≤ T'"
by auto
with wte typeof subs
show "P,E(V # Vs [↦] T' # Ts),h ⊢ e : T ∧
(∃Ts'. map P ⊢ typeof⇘h⇙ (v # vs) = map Some Ts' ∧ P ⊢ Ts' [≤] (T' # Ts))"
by auto
next
assume "P,E(V # Vs [↦] T' # Ts),h ⊢ e : T ∧
(∃Ts'. map P ⊢ typeof⇘h⇙ (v # vs) = map Some Ts' ∧ P ⊢ Ts' [≤] (T' # Ts))"
then obtain Ts' where wte:"P,E(V # Vs [↦] T' # Ts),h ⊢ e : T"
and typeof:"map P ⊢ typeof⇘h⇙ (v # vs) = map Some Ts'"
and subs:"P ⊢ Ts' [≤] (T'#Ts)" by auto
from subs obtain U Us where Ts':"Ts' = U#Us" by(cases Ts') auto
with wte typeof subs eq have blocks:"P,E(V ↦ T'),h ⊢ blocks (Vs,Ts,vs,e) : T"
by auto
from Ts' typeof subs have "P ⊢ typeof⇘h⇙ v = Some U"
and "P ⊢ U ≤ T'" by (auto simp:fun_of_def)
hence wtval:"P,E(V ↦ T'),h ⊢ V:=Val v : T'" by auto
with blocks typeT' show "P,E,h ⊢ blocks (V#Vs,T'#Ts,v#vs,e) : T" by auto
qed
qed auto
theorem assumes wf: "wf_C_prog P"
shows subject_reduction2: "P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',(h',l')⟩ ⟹
(⋀T. ⟦ P,E ⊢ (h,l) √; P,E,h ⊢ e : T ⟧ ⟹ P,E,h' ⊢ e' :⇘NT⇙ T)"
and subjects_reduction2: "P,E ⊢ ⟨es,(h,l)⟩ [→] ⟨es',(h',l')⟩ ⟹
(⋀Ts.⟦ P,E ⊢ (h,l) √; P,E,h ⊢ es [:] Ts ⟧ ⟹ types_conf P E h' es' Ts)"
proof (induct rule:red_reds_inducts)
case (RedNew h a h' C E l)
have new:"new_Addr h = Some a" and h':"h' = h(a ↦ (C, Collect (init_obj P C)))"
and wt:"P,E,h ⊢ new C : T" by fact+
from wt have eq:"T = Class C" and "class": "is_class P C" by auto
from "class" have subo:"Subobjs P C [C]" by(rule Subobjs_Base)
from h' have "h' a = Some(C, Collect (init_obj P C))" by(simp add:map_upd_Some_unfold)
with subo have "P,E,h' ⊢ ref(a,[C]) : Class C" by auto
with eq show ?case by auto
next
case (RedNewFail h E C l)
have sconf:"P,E ⊢ (h, l) √" by fact
from wf have "is_class P OutOfMemory"
by (fastforce intro:is_class_xcpt wf_prog_wwf_prog)
hence "preallocated h ⟹ P ⊢ typeof⇘h⇙ (Ref (addr_of_sys_xcpt OutOfMemory,[OutOfMemory])) = Some(Class OutOfMemory)"
by (auto elim: preallocatedE dest!:preallocatedD Subobjs_Base)
with sconf have "P,E,h ⊢ THROW OutOfMemory : T" by(auto simp:sconf_def hconf_def)
thus ?case by (fastforce intro:wt_same_type_typeconf)
next
case (StaticCastRed E e h l e' h' l' C)
have wt:"P,E,h ⊢ ⦇C⦈e : T"
and IH:"⋀T'. ⟦P,E ⊢ (h,l) √; P,E,h ⊢ e : T'⟧
⟹ P,E,h' ⊢ e' :⇘NT⇙ T'"
and sconf:"P,E ⊢ (h, l) √" by fact+
from wt obtain T' where wte:"P,E,h ⊢ e : T'" and isref:"is_refT T'"
and "class": "is_class P C" and T:"T = Class C"
by auto
from isref have "P,E,h' ⊢ ⦇C⦈e' : Class C"
proof(rule refTE)
assume "T' = NT"
with IH[OF sconf wte] isref "class" show ?thesis by auto
next
fix D assume "T' = Class D"
with IH[OF sconf wte] isref "class" show ?thesis by auto
qed
with T show ?case by (fastforce intro:wt_same_type_typeconf)
next
case RedStaticCastNull
thus ?case by (auto elim:WTrt.cases)
next
case (RedStaticUpCast Cs C Cs' Ds E a h l)
have wt:"P,E,h ⊢ ⦇C⦈ref (a,Cs) : T"
and path_via:"P ⊢ Path last Cs to C via Cs'"
and Ds:"Ds = Cs @⇩p Cs'" by fact+
from wt have typeof:"P ⊢ typeof⇘h⇙ (Ref(a,Cs)) = Some(Class(last Cs))"
and "class": "is_class P C" and T:"T = Class C"
by auto
from typeof obtain D S where h:"h a = Some(D,S)" and subo:"Subobjs P D Cs"
by (auto dest:typeof_Class_Subo split:if_split_asm)
from path_via subo wf Ds have "Subobjs P D Ds" and last:"last Ds = C"
by(auto intro!:Subobjs_appendPath appendPath_last[THEN sym] Subobjs_nonempty
simp:path_via_def)
with h have "P,E,h ⊢ ref (a,Ds) : Class C" by auto
with T show ?case by (fastforce intro:wt_same_type_typeconf)
next
case (RedStaticDownCast E C a Cs Cs' h l)
have "P,E,h ⊢ ⦇C⦈ref (a,Cs@[C]@Cs') : T" by fact
hence typeof:"P ⊢ typeof⇘h⇙ (Ref(a,Cs@[C]@Cs')) = Some(Class(last(Cs@[C]@Cs')))"
and "class": "is_class P C" and T:"T = Class C"
by auto
from typeof obtain D S where h:"h a = Some(D,S)"
and subo:"Subobjs P D (Cs@[C]@Cs')"
by (auto dest:typeof_Class_Subo split:if_split_asm)
from subo have "Subobjs P D (Cs@[C])" by(fastforce intro:appendSubobj)
with h have "P,E,h ⊢ ref (a,Cs@[C]) : Class C" by auto
with T show ?case by (fastforce intro:wt_same_type_typeconf)
next
case (RedStaticCastFail C Cs E a h l)
have sconf:"P,E ⊢ (h, l) √" by fact
from wf have "is_class P ClassCast"
by (fastforce intro:is_class_xcpt wf_prog_wwf_prog)
hence "preallocated h ⟹ P ⊢ typeof⇘h⇙ (Ref (addr_of_sys_xcpt ClassCast,[ClassCast])) = Some(Class ClassCast)"
by (auto elim: preallocatedE dest!:preallocatedD Subobjs_Base)
with sconf have "P,E,h ⊢ THROW ClassCast : T" by(auto simp:sconf_def hconf_def)
thus ?case by (fastforce intro:wt_same_type_typeconf)
next
case (DynCastRed E e h l e' h' l' C)
have wt:"P,E,h ⊢ Cast C e : T"
and IH:"⋀T'. ⟦P,E ⊢ (h,l) √; P,E,h ⊢ e : T'⟧
⟹ P,E,h' ⊢ e' :⇘NT⇙ T'"
and sconf:"P,E ⊢ (h,l) √" by fact+
from wt obtain T' where wte:"P,E,h ⊢ e : T'" and isref:"is_refT T'"
and "class": "is_class P C" and T:"T = Class C"
by auto
from isref have "P,E,h' ⊢ Cast C e' : Class C"
proof(rule refTE)
assume "T' = NT"
with IH[OF sconf wte] isref "class" show ?thesis by auto
next
fix D assume "T' = Class D"
with IH[OF sconf wte] isref "class" show ?thesis by auto
qed
with T show ?case by (fastforce intro:wt_same_type_typeconf)
next
case RedDynCastNull
thus ?case by (auto elim:WTrt.cases)
next
case (RedDynCast h l a D S C Cs' E Cs)
have wt:"P,E,h ⊢ Cast C (ref (a,Cs)) : T"
and path_via:"P ⊢ Path D to C via Cs'"
and hp:"hp (h,l) a = Some(D,S)" by fact+
from wt have typeof:"P ⊢ typeof⇘h⇙ (Ref(a,Cs)) = Some(Class(last Cs))"
and "class": "is_class P C" and T:"T = Class C"
by auto
from typeof hp have subo:"Subobjs P D Cs"
by (auto dest:typeof_Class_Subo split:if_split_asm)
from path_via subo have "Subobjs P D Cs'"
and last:"last Cs' = C" by (auto simp:path_via_def)
with hp have "P,E,h ⊢ ref (a,Cs') : Class C" by auto
with T show ?case by (fastforce intro:wt_same_type_typeconf)
next
case (RedStaticUpDynCast Cs C Cs' Ds E a h l)
have wt:"P,E,h ⊢ Cast C (ref (a,Cs)) : T"
and path_via:"P ⊢ Path last Cs to C via Cs'"
and Ds:"Ds = Cs @⇩p Cs'" by fact+
from wt have typeof:"P ⊢ typeof⇘h⇙ (Ref(a,Cs)) = Some(Class(last Cs))"
and "class": "is_class P C" and T:"T = Class C"
by auto
from typeof obtain D S where h:"h a = Some(D,S)" and subo:"Subobjs P D Cs"
by (auto dest:typeof_Class_Subo split:if_split_asm)
from path_via subo wf Ds have "Subobjs P D Ds" and last:"last Ds = C"
by(auto intro!:Subobjs_appendPath appendPath_last[THEN sym] Subobjs_nonempty
simp:path_via_def)
with h have "P,E,h ⊢ ref (a,Ds) : Class C" by auto
with T show ?case by (fastforce intro:wt_same_type_typeconf)
next
case (RedStaticDownDynCast E C a Cs Cs' h l)
have "P,E,h ⊢ Cast C (ref (a,Cs@[C]@Cs')) : T" by fact
hence typeof:"P ⊢ typeof⇘h⇙ (Ref(a,Cs@[C]@Cs')) = Some(Class(last(Cs@[C]@Cs')))"
and "class": "is_class P C" and T:"T = Class C"
by auto
from typeof obtain D S where h:"h a = Some(D,S)"
and subo:"Subobjs P D (Cs@[C]@Cs')"
by (auto dest:typeof_Class_Subo split:if_split_asm)
from subo have "Subobjs P D (Cs@[C])" by(fastforce intro:appendSubobj)
with h have "P,E,h ⊢ ref (a,Cs@[C]) : Class C" by auto
with T show ?case by (fastforce intro:wt_same_type_typeconf)
next
case RedDynCastFail thus ?case by fastforce
next
case (BinOpRed1 E e h l e' h' l' bop e⇩2)
have red:"P,E ⊢ ⟨e,(h, l)⟩ → ⟨e',(h', l')⟩"
and wt:"P,E,h ⊢ e «bop» e⇩2 : T"
and IH:"⋀T'. ⟦P,E ⊢ (h,l) √; P,E,h ⊢ e : T'⟧
⟹ P,E,h' ⊢ e' :⇘NT⇙ T'"
and sconf:"P,E ⊢ (h,l) √" by fact+
from wt obtain T⇩1 T⇩2 where wte:"P,E,h ⊢ e : T⇩1" and wte2:"P,E,h ⊢ e⇩2 : T⇩2"
and binop:"case bop of Eq ⇒ T = Boolean
| Add ⇒ T⇩1 = Integer ∧ T⇩2 = Integer ∧ T = Integer"
by auto
from WTrt_hext_mono[OF wte2 red_hext_incr[OF red]] have wte2':"P,E,h' ⊢ e⇩2 : T⇩2" .
have "P,E,h' ⊢ e' «bop» e⇩2 : T"
proof (cases bop)
assume Eq:"bop = Eq"
from IH[OF sconf wte] obtain T' where "P,E,h' ⊢ e' : T'"
by (cases "T⇩1") auto
with wte2' binop Eq show ?thesis by(cases bop) auto
next
assume Add:"bop = Add"
with binop have Intg:"T⇩1 = Integer" by simp
with IH[OF sconf wte] have "P,E,h' ⊢ e' : Integer" by simp
with wte2' binop Add show ?thesis by(cases bop) auto
qed
with binop show ?case by(cases bop) simp_all
next
case (BinOpRed2 E e h l e' h' l' v⇩1 bop)
have red:"P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',(h',l')⟩"
and wt:"P,E,h ⊢ Val v⇩1 «bop» e : T"
and IH:"⋀T'. ⟦P,E ⊢ (h,l) √; P,E,h ⊢ e : T'⟧
⟹ P,E,h' ⊢ e' :⇘NT⇙ T'"
and sconf:"P,E ⊢ (h,l) √" by fact+
from wt obtain T⇩1 T⇩2 where wtval:"P,E,h ⊢ Val v⇩1 : T⇩1" and wte:"P,E,h ⊢ e : T⇩2"
and binop:"case bop of Eq ⇒ T = Boolean
| Add ⇒ T⇩1 = Integer ∧ T⇩2 = Integer ∧ T = Integer"
by auto
from WTrt_hext_mono[OF wtval red_hext_incr[OF red]]
have wtval':"P,E,h' ⊢ Val v⇩1 : T⇩1" .
have "P,E,h' ⊢ Val v⇩1 «bop» e' : T"
proof (cases bop)
assume Eq:"bop = Eq"
from IH[OF sconf wte] obtain T' where "P,E,h' ⊢ e' : T'"
by (cases "T⇩2") auto
with wtval' binop Eq show ?thesis by(cases bop) auto
next
assume Add:"bop = Add"
with binop have Intg:"T⇩2 = Integer" by simp
with IH[OF sconf wte] have "P,E,h' ⊢ e' : Integer" by simp
with wtval' binop Add show ?thesis by(cases bop) auto
qed
with binop show ?case by(cases bop) simp_all
next
case (RedBinOp bop v⇩1 v⇩2 v E a b) thus ?case
proof (cases bop)
case Eq thus ?thesis using RedBinOp by auto
next
case Add thus ?thesis using RedBinOp by auto
qed
next
case (RedVar h l V v E)
have l:"lcl (h, l) V = Some v" and sconf:"P,E ⊢ (h, l) √"
and wt:"P,E,h ⊢ Var V : T" by fact+
hence conf:"P,h ⊢ v :≤ T" by(force simp:sconf_def lconf_def)
show ?case
proof(cases "∀C. T ≠ Class C")
case True
with conf have "P ⊢ typeof⇘h⇙ v = Some T" by(cases T) auto
hence "P,E,h ⊢ Val v : T" by auto
thus ?thesis by(rule wt_same_type_typeconf)
next
case False
then obtain C where T:"T = Class C" by auto
with conf have "P ⊢ typeof⇘h⇙ v = Some(Class C) ∨ P ⊢ typeof⇘h⇙ v = Some NT"
by simp
with T show ?thesis by simp
qed
next
case (LAssRed E e h l e' h' l' V)
have wt:"P,E,h ⊢ V:=e : T" and sconf:"P,E ⊢ (h, l) √"
and IH:"⋀T'. ⟦P,E ⊢ (h, l) √; P,E,h ⊢ e : T'⟧ ⟹ P,E,h' ⊢ e' :⇘NT⇙ T'" by fact+
from wt obtain T' where wte:"P,E,h ⊢ e : T'" and env:"E V = Some T"
and sub:"P ⊢ T' ≤ T" by auto
from sconf env have "is_type P T" by(auto simp:sconf_def envconf_def)
from sub this wf show ?case
proof(rule subE)
assume eq:"T' = T" and notclass:"∀C. T' ≠ Class C"
with IH[OF sconf wte] have "P,E,h' ⊢ e' : T" by(cases T) auto
with eq env have "P,E,h' ⊢ V:=e' : T" by auto
with eq show ?thesis by(cases T) auto
next
fix C D
assume T':"T' = Class C" and T:"T = Class D"
and path_unique:"P ⊢ Path C to D unique"
with IH[OF sconf wte] have "P,E,h' ⊢ e' : Class C ∨ P,E,h' ⊢ e' : NT"
by simp
hence "P,E,h' ⊢ V:=e' : T"
proof(rule disjE)
assume "P,E,h' ⊢ e' : Class C"
with env T' sub show ?thesis by (fastforce intro:WTrtLAss)
next
assume "P,E,h' ⊢ e' : NT"
with env T show ?thesis by (fastforce intro:WTrtLAss)
qed
with T show ?thesis by(cases T) auto
next
fix C
assume T':"T' = NT" and T:"T = Class C"
with IH[OF sconf wte] have "P,E,h' ⊢ e' : NT" by simp
with env T show ?thesis by (fastforce intro:WTrtLAss)
qed
next
case (RedLAss E V T v v' h l T')
have env:"E V = Some T" and casts:"P ⊢ T casts v to v'"
and sconf:"P,E ⊢ (h, l) √" and wt:"P,E,h ⊢ V:=Val v : T'" by fact+
show ?case
proof(cases "∀C. T ≠ Class C")
case True
with casts wt env show ?thesis
by(cases T',auto elim!:casts_to.cases)
next
case False
then obtain C where "T = Class C" by auto
with casts wt env wf show ?thesis
by(auto elim!:casts_to.cases,
auto intro!:sym[OF appendPath_last] Subobjs_nonempty split:if_split_asm
simp:path_via_def,drule_tac Cs="Cs" in Subobjs_appendPath,auto)
qed
next
case (FAccRed E e h l e' h' l' F Cs)
have red:"P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',(h',l')⟩"
and wt:"P,E,h ⊢ e∙F{Cs} : T"
and IH:"⋀T'. ⟦P,E ⊢ (h,l) √; P,E,h ⊢ e : T'⟧
⟹ P,E,h' ⊢ e' :⇘NT⇙ T'"
and sconf:"P,E ⊢ (h,l) √" by fact+
from wt have "P,E,h' ⊢ e'∙F{Cs} : T"
proof(rule WTrt_elim_cases)
fix C assume wte: "P,E,h ⊢ e : Class C"
and field:"P ⊢ C has least F:T via Cs"
and notemptyCs:"Cs ≠ []"
from field have "class": "is_class P C"
by (fastforce intro:Subobjs_isClass simp add:LeastFieldDecl_def FieldDecls_def)
from IH[OF sconf wte] have "P,E,h' ⊢ e' : NT ∨ P,E,h' ⊢ e' : Class C" by auto
thus ?thesis
proof(rule disjE)
assume "P,E,h' ⊢ e' : NT"
thus ?thesis by (fastforce intro!:WTrtFAccNT)
next
assume wte':"P,E,h' ⊢ e' : Class C"
from wte' notemptyCs field show ?thesis by(rule WTrtFAcc)
qed
next
assume wte: "P,E,h ⊢ e : NT"
from IH[OF sconf wte] have "P,E,h' ⊢ e' : NT" by auto
thus ?thesis by (rule WTrtFAccNT)
qed
thus ?case by(rule wt_same_type_typeconf)
next
case (RedFAcc h l a D S Ds Cs' Cs fs' F v E)
have h:"hp (h,l) a = Some(D,S)"
and Ds:"Ds = Cs'@⇩pCs" and S:"(Ds,fs') ∈ S"
and fs':"fs' F = Some v" and sconf:"P,E ⊢ (h,l) √"
and wte:"P,E,h ⊢ ref (a,Cs')∙F{Cs} : T" by fact+
from wte have field:"P ⊢ last Cs' has least F:T via Cs"
and notemptyCs:"Cs ≠ []"
by (auto split:if_split_asm)
from h S sconf obtain Bs fs ms where classDs:"class P (last Ds) = Some (Bs,fs,ms)"
and fconf:"P,h ⊢ fs' (:≤) map_of fs"
by (simp add:sconf_def hconf_def oconf_def) blast
from field Ds have "last Cs = last Ds"
by (fastforce intro!:appendPath_last Subobjs_nonempty
simp:LeastFieldDecl_def FieldDecls_def)
with field classDs have map:"map_of fs F = Some T"
by (simp add:LeastFieldDecl_def FieldDecls_def)
with fconf fs' have conf:"P,h ⊢ v :≤ T"
by (simp add:fconf_def,erule_tac x="F" in allE,fastforce)
thus ?case by (cases T) auto
next
case (RedFAccNull E F Cs h l)
have sconf:"P,E ⊢ (h, l) √" by fact
from wf have "is_class P NullPointer"
by (fastforce intro:is_class_xcpt wf_prog_wwf_prog)
hence "preallocated h ⟹ P ⊢ typeof⇘h⇙ (Ref (addr_of_sys_xcpt NullPointer,[NullPointer])) = Some(Class NullPointer)"
by (auto elim: preallocatedE dest!:preallocatedD Subobjs_Base)
with sconf have "P,E,h ⊢ THROW NullPointer : T" by(auto simp:sconf_def hconf_def)
thus ?case by (fastforce intro:wt_same_type_typeconf wf_prog_wwf_prog)
next
case (FAssRed1 E e h l e' h' l' F Cs e⇩2)
have red:"P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',(h',l')⟩"
and wt:"P,E,h ⊢ e∙F{Cs} := e⇩2 : T"
and IH:"⋀T'. ⟦P,E ⊢ (h,l) √; P,E,h ⊢ e : T'⟧
⟹ P,E,h' ⊢ e' :⇘NT⇙ T'"
and sconf:"P,E ⊢ (h,l) √" by fact+
from wt have "P,E,h' ⊢ e'∙F{Cs} := e⇩2 : T"
proof (rule WTrt_elim_cases)
fix C T' assume wte: "P,E,h ⊢ e : Class C"
and field:"P ⊢ C has least F:T via Cs"
and notemptyCs:"Cs ≠ []"
and wte2:"P,E,h ⊢ e⇩2 : T'" and sub:"P ⊢ T' ≤ T"
have wte2': "P,E,h' ⊢ e⇩2 : T'"
by(rule WTrt_hext_mono[OF wte2 red_hext_incr[OF red]])
from IH[OF sconf wte] have "P,E,h' ⊢ e' : Class C ∨ P,E,h' ⊢ e' : NT"
by simp
thus ?thesis
proof(rule disjE)
assume wte':"P,E,h' ⊢ e' : Class C"
from wte' notemptyCs field wte2' sub show ?thesis by (rule WTrtFAss)
next
assume wte':"P,E,h' ⊢ e' : NT"
from wte' wte2' sub show ?thesis by (rule WTrtFAssNT)
qed
next
fix T' assume wte:"P,E,h ⊢ e : NT"
and wte2:"P,E,h ⊢ e⇩2 : T'" and sub:"P ⊢ T' ≤ T"
have wte2': "P,E,h' ⊢ e⇩2 : T'"
by(rule WTrt_hext_mono[OF wte2 red_hext_incr[OF red]])
from IH[OF sconf wte] have wte':"P,E,h' ⊢ e' : NT" by simp
from wte' wte2' sub show ?thesis by (rule WTrtFAssNT)
qed
thus ?case by(rule wt_same_type_typeconf)
next
case (FAssRed2 E e h l e' h' l' v F Cs)
have red:"P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',(h',l')⟩"
and wt:"P,E,h ⊢ Val v∙F{Cs} := e : T"
and IH:"⋀T'. ⟦P,E ⊢ (h,l) √; P,E,h ⊢ e : T'⟧
⟹ P,E,h' ⊢ e' :⇘NT⇙ T'"
and sconf:"P,E ⊢ (h,l) √" by fact+
from wt have "P,E,h' ⊢ Val v∙F{Cs}:=e' : T"
proof (rule WTrt_elim_cases)
fix C T' assume wtval:"P,E,h ⊢ Val v : Class C"
and field:"P ⊢ C has least F:T via Cs"
and notemptyCs:"Cs ≠ []"
and wte:"P,E,h ⊢ e : T'"
and sub:"P ⊢ T' ≤ T"
have wtval':"P,E,h' ⊢ Val v : Class C"
by(rule WTrt_hext_mono[OF wtval red_hext_incr[OF red]])
from field wf have type:"is_type P T" by(rule least_field_is_type)
from sub type wf show ?thesis
proof(rule subE)
assume "T' = T" and notclass:"∀C. T' ≠ Class C"
from IH[OF sconf wte] notclass have wte':"P,E,h' ⊢ e' : T'"
by(cases T') auto
from wtval' notemptyCs field wte' sub show ?thesis
by(rule WTrtFAss)
next
fix C' D assume T':"T' = Class C'" and T:"T = Class D"
and path_unique:"P ⊢ Path C' to D unique"
from IH[OF sconf wte] T' have "P,E,h' ⊢ e' : Class C' ∨ P,E,h' ⊢ e' : NT"
by simp
thus ?thesis
proof(rule disjE)
assume wte':"P,E,h' ⊢ e' : Class C'"
from wtval' notemptyCs field wte' sub T' show ?thesis
by (fastforce intro: WTrtFAss)
next
assume wte':"P,E,h' ⊢ e' : NT"
from wtval' notemptyCs field wte' sub T show ?thesis
by (fastforce intro: WTrtFAss)
qed
next
fix C' assume T':"T' = NT" and T:"T = Class C'"
from IH[OF sconf wte] T' have wte':"P,E,h' ⊢ e' : NT" by simp
from wtval' notemptyCs field wte' sub T show ?thesis
by (fastforce intro: WTrtFAss)
qed
next
fix T' assume wtval:"P,E,h ⊢ Val v : NT"
and wte:"P,E,h ⊢ e : T'"
and sub:"P ⊢ T' ≤ T"
have wtval':"P,E,h' ⊢ Val v : NT"
by(rule WTrt_hext_mono[OF wtval red_hext_incr[OF red]])
from IH[OF sconf wte] sub obtain T'' where wte':"P,E,h' ⊢ e' : T''"
and sub':"P ⊢ T'' ≤ T" by (cases T',auto,cases T,auto)
from wtval' wte' sub' show ?thesis
by(rule WTrtFAssNT)
qed
thus ?case by(rule wt_same_type_typeconf)
next
case (RedFAss h a D S Cs' F T Cs v v' Ds fs E l T')
let ?fs' = "fs(F ↦ v')"
let ?S' = "insert (Ds, ?fs') (S - {(Ds, fs)})"
let ?h' = "h(a ↦ (D,?S'))"
have h:"h a = Some(D,S)" and casts:"P ⊢ T casts v to v'"
and field:"P ⊢ last Cs' has least F:T via Cs"
and wt:"P,E,h ⊢ ref (a,Cs')∙F{Cs} := Val v : T'" by fact+
from wt wf have type:"is_type P T'"
by (auto dest:least_field_is_type split:if_split_asm)
from wt field obtain T'' where wtval:"P,E,h ⊢ Val v : T''" and eq:"T = T'"
and leq:"P ⊢ T'' ≤ T'"
by (auto dest:sees_field_fun split:if_split_asm)
from casts eq wtval show ?case
proof(induct rule:casts_to.induct)
case (casts_prim T⇩0 w)
have "T⇩0 = T'" and "∀C. T⇩0 ≠ Class C" and wtval':"P,E,h ⊢ Val w : T''" by fact+
with leq have "T' = T''" by(cases T',auto)
with wtval' have "P,E,h ⊢ Val w : T'" by simp
with h have "P,E,(h(a↦(D,insert(Ds,fs(F ↦ w))(S-{(Ds,fs)})))) ⊢ Val w : T'"
by(cases w,auto split:if_split_asm)
thus "P,E,(h(a↦(D,insert(Ds,fs(F ↦ w))(S-{(Ds,fs)})))) ⊢ (Val w) :⇘NT⇙ T'"
by(rule wt_same_type_typeconf)
next
case (casts_null C'')
have T':"Class C'' = T'" by fact
have "P,E,(h(a↦(D,insert(Ds,fs(F ↦ Null))(S-{(Ds,fs)})))) ⊢ null : NT"
by simp
with sym[OF T']
show "P,E,(h(a↦(D,insert(Ds,fs(F ↦ Null))(S-{(Ds,fs)})))) ⊢ null :⇘NT⇙ T'"
by simp
next
case (casts_ref Xs C'' Xs' Ds'' a')
have "Class C'' = T'" and "Ds'' = Xs @⇩p Xs'"
and "P ⊢ Path last Xs to C'' via Xs'"
and "P,E,h ⊢ ref (a', Xs) : T''" by fact+
with wf have "P,E,h ⊢ ref (a',Ds'') : T'"
by (auto intro!:appendPath_last[THEN sym] Subobjs_nonempty
split:if_split_asm simp:path_via_def,
drule_tac Cs="Xs" in Subobjs_appendPath,auto)
with h have "P,E,(h(a↦(D,insert(Ds,fs(F ↦ Ref(a',Ds'')))(S-{(Ds,fs)})))) ⊢
ref (a',Ds'') : T'"
by auto
thus "P,E,(h(a↦(D,insert(Ds,fs(F ↦ Ref(a',Ds'')))(S-{(Ds,fs)})))) ⊢
ref (a',Ds'') :⇘NT⇙ T'"
by(rule wt_same_type_typeconf)
qed
next
case (RedFAssNull E F Cs v h l)
have sconf:"P,E ⊢ (h, l) √" by fact
from wf have "is_class P NullPointer"
by (fastforce intro:is_class_xcpt wf_prog_wwf_prog)
hence "preallocated h ⟹ P ⊢ typeof⇘h⇙ (Ref (addr_of_sys_xcpt NullPointer,[NullPointer])) = Some(Class NullPointer)"
by (auto elim: preallocatedE dest!:preallocatedD Subobjs_Base)
with sconf have "P,E,h ⊢ THROW NullPointer : T" by(auto simp:sconf_def hconf_def)
thus ?case by (fastforce intro:wt_same_type_typeconf wf_prog_wwf_prog)
next
case (CallObj E e h l e' h' l' Copt M es)
have red: "P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',(h',l')⟩"
and IH: "⋀T'. ⟦P,E ⊢ (h,l) √; P,E,h ⊢ e : T'⟧
⟹ P,E,h' ⊢ e' :⇘NT⇙ T'"
and sconf: "P,E ⊢ (h,l) √" and wt: "P,E,h ⊢ Call e Copt M es : T" by fact+
from wt have "P,E,h' ⊢ Call e' Copt M es : T"
proof(cases Copt)
case None
with wt have "P,E,h ⊢ e∙M(es) : T" by simp
hence "P,E,h' ⊢ e'∙M(es) : T"
proof(rule WTrt_elim_cases)
fix C Cs Ts Ts' m
assume wte:"P,E,h ⊢ e : Class C"
and "method":"P ⊢ C has least M = (Ts, T, m) via Cs"
and wtes:"P,E,h ⊢ es [:] Ts'" and subs: "P ⊢ Ts' [≤] Ts"
from IH[OF sconf wte] have "P,E,h' ⊢ e' : NT ∨ P,E,h' ⊢ e' : Class C" by auto
thus ?thesis
proof(rule disjE)
assume wte':"P,E,h' ⊢ e' : NT"
have "P,E,h' ⊢ es [:] Ts'"
by(rule WTrts_hext_mono[OF wtes red_hext_incr[OF red]])
with wte' show ?thesis by(rule WTrtCallNT)
next
assume wte':"P,E,h' ⊢ e' : Class C"
have wtes':"P,E,h' ⊢ es [:] Ts'"
by(rule WTrts_hext_mono[OF wtes red_hext_incr[OF red]])
from wte' "method" wtes' subs show ?thesis by(rule WTrtCall)
qed
next
fix Ts
assume wte:"P,E,h ⊢ e : NT" and wtes:"P,E,h ⊢ es [:] Ts"
from IH[OF sconf wte] have wte':"P,E,h' ⊢ e' : NT" by simp
have "P,E,h' ⊢ es [:] Ts"
by(rule WTrts_hext_mono[OF wtes red_hext_incr[OF red]])
with wte' show ?thesis by(rule WTrtCallNT)
qed
with None show ?thesis by simp
next
case (Some C)
with wt have "P,E,h ⊢ e∙(C::)M(es) : T" by simp
hence "P,E,h' ⊢ e'∙(C::)M(es) : T"
proof(rule WTrt_elim_cases)
fix C' Cs Ts Ts' m
assume wte:"P,E,h ⊢ e : Class C'" and path_unique:"P ⊢ Path C' to C unique"
and "method":"P ⊢ C has least M = (Ts, T, m) via Cs"
and wtes:"P,E,h ⊢ es [:] Ts'" and subs: "P ⊢ Ts' [≤] Ts"
from IH[OF sconf wte] have "P,E,h' ⊢ e' : NT ∨ P,E,h' ⊢ e' : Class C'" by auto
thus ?thesis
proof(rule disjE)
assume wte':"P,E,h' ⊢ e' : NT"
have "P,E,h' ⊢ es [:] Ts'"
by(rule WTrts_hext_mono[OF wtes red_hext_incr[OF red]])
with wte' show ?thesis by(rule WTrtCallNT)
next
assume wte':"P,E,h' ⊢ e' : Class C'"
have wtes':"P,E,h' ⊢ es [:] Ts'"
by(rule WTrts_hext_mono[OF wtes red_hext_incr[OF red]])
from wte' path_unique "method" wtes' subs show ?thesis by(rule WTrtStaticCall)
qed
next
fix Ts
assume wte:"P,E,h ⊢ e : NT" and wtes:"P,E,h ⊢ es [:] Ts"
from IH[OF sconf wte] have wte':"P,E,h' ⊢ e' : NT" by simp
have "P,E,h' ⊢ es [:] Ts"
by(rule WTrts_hext_mono[OF wtes red_hext_incr[OF red]])
with wte' show ?thesis by(rule WTrtCallNT)
qed
with Some show ?thesis by simp
qed
thus ?case by (rule wt_same_type_typeconf)
next
case (CallParams E es h l es' h' l' v Copt M)
have reds: "P,E ⊢ ⟨es,(h,l)⟩ [→] ⟨es',(h',l')⟩"
and IH: "⋀Ts. ⟦P,E ⊢ (h,l) √; P,E,h ⊢ es [:] Ts⟧
⟹ types_conf P E h' es' Ts"
and sconf: "P,E ⊢ (h,l) √" and wt: "P,E,h ⊢ Call (Val v) Copt M es : T" by fact+
from wt have "P,E,h' ⊢ Call (Val v) Copt M es' : T"
proof(cases Copt)
case None
with wt have "P,E,h ⊢ (Val v)∙M(es) : T" by simp
hence "P,E,h' ⊢ Val v∙M(es') : T"
proof (rule WTrt_elim_cases)
fix C Cs Ts Ts' m
assume wte: "P,E,h ⊢ Val v : Class C"
and "method":"P ⊢ C has least M = (Ts,T,m) via Cs"
and wtes: "P,E,h ⊢ es [:] Ts'" and subs:"P ⊢ Ts' [≤] Ts"
from wtes have "length es = length Ts'" by(rule WTrts_same_length)
with reds have "length es' = length Ts'"
by -(drule reds_length,simp)
with IH[OF sconf wtes] subs obtain Ts'' where wtes':"P,E,h' ⊢ es' [:] Ts''"
and subs':"P ⊢ Ts'' [≤] Ts" by(auto dest:types_conf_smaller_types)
have wte':"P,E,h' ⊢ Val v : Class C"
by(rule WTrt_hext_mono[OF wte reds_hext_incr[OF reds]])
from wte' "method" wtes' subs' show ?thesis
by(rule WTrtCall)
next
fix Ts
assume wte:"P,E,h ⊢ Val v : NT"
and wtes:"P,E,h ⊢ es [:] Ts"
from wtes have "length es = length Ts" by(rule WTrts_same_length)
with reds have "length es' = length Ts"
by -(drule reds_length,simp)
with IH[OF sconf wtes] obtain Ts' where wtes':"P,E,h' ⊢ es' [:] Ts'"
and "P ⊢ Ts' [≤] Ts" by(auto dest:types_conf_smaller_types)
have wte':"P,E,h' ⊢ Val v : NT"
by(rule WTrt_hext_mono[OF wte reds_hext_incr[OF reds]])
from wte' wtes' show ?thesis by(rule WTrtCallNT)
qed
with None show ?thesis by simp
next
case (Some C)
with wt have "P,E,h ⊢ (Val v)∙(C::)M(es) : T" by simp
hence "P,E,h' ⊢ (Val v)∙(C::)M(es') : T"
proof(rule WTrt_elim_cases)
fix C' Cs Ts Ts' m
assume wte:"P,E,h ⊢ Val v : Class C'" and path_unique:"P ⊢ Path C' to C unique"
and "method":"P ⊢ C has least M = (Ts,T,m) via Cs"
and wtes:"P,E,h ⊢ es [:] Ts'" and subs: "P ⊢ Ts' [≤] Ts"
from wtes have "length es = length Ts'" by(rule WTrts_same_length)
with reds have "length es' = length Ts'"
by -(drule reds_length,simp)
with IH[OF sconf wtes] subs obtain Ts'' where wtes':"P,E,h' ⊢ es' [:] Ts''"
and subs':"P ⊢ Ts'' [≤] Ts" by(auto dest:types_conf_smaller_types)
have wte':"P,E,h' ⊢ Val v : Class C'"
by(rule WTrt_hext_mono[OF wte reds_hext_incr[OF reds]])
from wte' path_unique "method" wtes' subs' show ?thesis
by(rule WTrtStaticCall)
next
fix Ts
assume wte:"P,E,h ⊢ Val v : NT"
and wtes:"P,E,h ⊢ es [:] Ts"
from wtes have "length es = length Ts" by(rule WTrts_same_length)
with reds have "length es' = length Ts"
by -(drule reds_length,simp)
with IH[OF sconf wtes] obtain Ts' where wtes':"P,E,h' ⊢ es' [:] Ts'"
and "P ⊢ Ts' [≤] Ts" by(auto dest:types_conf_smaller_types)
have wte':"P,E,h' ⊢ Val v : NT"
by(rule WTrt_hext_mono[OF wte reds_hext_incr[OF reds]])
from wte' wtes' show ?thesis by(rule WTrtCallNT)
qed
with Some show ?thesis by simp
qed
thus ?case by (rule wt_same_type_typeconf)
next
case (RedCall h l a C S Cs M Ts' T' pns' body' Ds Ts T pns body Cs'
vs bs new_body E T'')
have hp:"hp (h,l) a = Some(C,S)"
and "method":"P ⊢ last Cs has least M = (Ts',T',pns',body') via Ds"
and select:"P ⊢ (C,Cs@⇩pDs) selects M = (Ts,T,pns,body) via Cs'"
and length1:"length vs = length pns" and length2:"length Ts = length pns"
and bs:"bs = blocks(this#pns,Class(last Cs')#Ts,Ref(a,Cs')#vs,body)"
and body_case:"new_body = (case T' of Class D ⇒ ⦇D⦈bs | _ ⇒ bs)"
and wt:"P,E,h ⊢ ref (a,Cs)∙M(map Val vs) : T''" by fact+
from wt hp "method" wf obtain Ts''
where wtref:"P,E,h ⊢ ref (a,Cs) : Class (last Cs)" and eq:"T'' = T'"
and wtes:"P,E,h ⊢ map Val vs [:] Ts''" and subs: "P ⊢ Ts'' [≤] Ts'"
by(auto dest:wf_sees_method_fun split:if_split_asm)
from select wf have "is_class P (last Cs')"
by(induct rule:SelectMethodDef.induct,
auto intro:Subobj_last_isClass simp:FinalOverriderMethodDef_def
OverriderMethodDefs_def MinimalMethodDefs_def LeastMethodDef_def MethodDefs_def)
with select_method_wf_mdecl[OF wf select]
have length_pns:"length (this#pns) = length (Class(last Cs')#Ts)"
and notNT:"T ≠ NT" and type:"∀T∈set (Class(last Cs')#Ts). is_type P T"
and wtabody:"P,[this↦Class(last Cs'),pns[↦]Ts] ⊢ body :: T"
by(auto simp:wf_mdecl_def)
from wtes hp select
have map:"map (P ⊢ typeof⇘h⇙) (Ref(a,Cs')#vs) = map Some (Class(last Cs')#Ts'')"
by(auto elim:SelectMethodDef.cases split:if_split_asm
simp:FinalOverriderMethodDef_def OverriderMethodDefs_def
MinimalMethodDefs_def LeastMethodDef_def MethodDefs_def)
from wtref hp have "P ⊢ Path C to (last Cs) via Cs"
by (auto simp:path_via_def split:if_split_asm)
with select "method" wf have "Ts' = Ts ∧ P ⊢ T ≤ T'"
by -(rule select_least_methods_subtypes,simp_all)
hence eqs:"Ts' = Ts" and sub:"P ⊢ T ≤ T'" by auto
from wf wtabody have "P,Map.empty(this↦Class(last Cs'),pns[↦]Ts),h ⊢ body : T"
by -(rule WT_implies_WTrt,simp_all)
hence wtbody:"P,E(this#pns [↦] Class (last Cs')#Ts),h ⊢ body : T"
by(rule WTrt_env_mono) simp
from wtes have "length vs = length Ts''"
by (fastforce dest:WTrts_same_length)
with eqs subs
have length_vs:"length (Ref(a,Cs')#vs) = length (Class(last Cs')#Ts)"
by (simp add:list_all2_iff)
from subs eqs have "P ⊢ (Class(last Cs')#Ts'') [≤] (Class(last Cs')#Ts)"
by (simp add:fun_of_def)
with wt_blocks[OF length_pns length_vs type] wtbody map eq
have blocks:"P,E,h ⊢ blocks(this#pns,Class(last Cs')#Ts,Ref(a,Cs')#vs,body) : T"
by auto
have "P,E,h ⊢ new_body : T'"
proof(cases "∀C. T' ≠ Class C")
case True
with sub notNT have "T = T'" by (cases T') auto
with blocks True body_case bs show ?thesis by(cases T') auto
next
case False
then obtain D where T':"T' = Class D" by auto
with "method" sub wf have "class": "is_class P D"
by (auto elim!:widen.cases dest:least_method_is_type
intro:Subobj_last_isClass simp:path_unique_def)
with blocks T' body_case bs "class" sub show ?thesis
by(cases T',auto,cases T,auto)
qed
with eq show ?case by(fastforce intro:wt_same_type_typeconf)
next
case (RedStaticCall Cs C Cs'' M Ts T pns body Cs' Ds vs E a h l T')
have "method":"P ⊢ C has least M = (Ts, T, pns, body) via Cs'"
and length1:"length vs = length pns"
and length2:"length Ts = length pns"
and path_unique:"P ⊢ Path last Cs to C unique"
and path_via:"P ⊢ Path last Cs to C via Cs''"
and Ds:"Ds = (Cs @⇩p Cs'') @⇩p Cs'"
and wt:"P,E,h ⊢ ref (a,Cs)∙(C::)M(map Val vs) : T'" by fact+
from wt "method" wf obtain Ts'
where wtref:"P,E,h ⊢ ref (a,Cs) : Class (last Cs)"
and wtes:"P,E,h ⊢ map Val vs [:] Ts'" and subs:"P ⊢ Ts' [≤] Ts"
and TeqT':"T = T'"
by(auto dest:wf_sees_method_fun split:if_split_asm)
from wtref obtain D S where hp:"h a = Some(D,S)" and subo:"Subobjs P D Cs"
by (auto split:if_split_asm)
from length1 length2
have length_vs: "length (Ref(a,Ds)#vs) = length (Class (last Ds)#Ts)" by simp
from length2 have length_pns:"length (this#pns) = length (Class (last Ds)#Ts)"
by simp
from "method" have "Cs' ≠ []"
by (fastforce intro!:Subobjs_nonempty simp add:LeastMethodDef_def MethodDefs_def)
with Ds have last:"last Cs' = last Ds"
by (fastforce dest:appendPath_last)
with "method" have "is_class P (last Ds)"
by(auto simp:LeastMethodDef_def MethodDefs_def is_class_def)
with last has_least_wf_mdecl[OF wf "method"]
have wtabody: "P,[this#pns [↦] Class (last Ds)#Ts] ⊢ body :: T"
and type:"∀T∈set (Class(last Ds)#Ts). is_type P T"
by(auto simp:wf_mdecl_def)
from path_via have suboCs'':"Subobjs P (last Cs) Cs''"
and lastCs'':"last Cs'' = C"
by (auto simp add:path_via_def)
with subo wf have subo':"Subobjs P D (Cs@⇩pCs'')"
by(fastforce intro: Subobjs_appendPath)
from lastCs'' suboCs'' have lastC:"C = last(Cs@⇩pCs'')"
by (fastforce dest:Subobjs_nonempty intro:appendPath_last)
from "method" have "Subobjs P C Cs'"
by (auto simp:LeastMethodDef_def MethodDefs_def)
with subo' wf lastC have "Subobjs P D ((Cs @⇩p Cs'') @⇩p Cs')"
by (fastforce intro:Subobjs_appendPath)
with Ds have suboDs:"Subobjs P D Ds" by simp
from wtabody have "P,Map.empty(this#pns [↦] Class (last Ds)#Ts),h ⊢ body : T"
by(rule WT_implies_WTrt)
hence "P,E(this#pns [↦] Class (last Ds)#Ts),h ⊢ body : T"
by(rule WTrt_env_mono) simp
hence "P,E,h ⊢ blocks(this#pns, Class (last Ds)#Ts, Ref(a,Ds)#vs, body) : T"
using wtes subs wt_blocks[OF length_pns length_vs type] hp suboDs
by(auto simp add:rel_list_all2_Cons2)
with TeqT' show ?case by(fastforce intro:wt_same_type_typeconf)
next
case (RedCallNull E Copt M vs h l)
have sconf:"P,E ⊢ (h, l) √" by fact
from wf have "is_class P NullPointer"
by (fastforce intro:is_class_xcpt wf_prog_wwf_prog)
hence "preallocated h ⟹ P ⊢ typeof⇘h⇙ (Ref (addr_of_sys_xcpt NullPointer,[NullPointer])) = Some(Class NullPointer)"
by (auto elim: preallocatedE dest!:preallocatedD Subobjs_Base)
with sconf have "P,E,h ⊢ THROW NullPointer : T" by(auto simp:sconf_def hconf_def)
thus ?case by (fastforce intro:wt_same_type_typeconf)
next
case (BlockRedNone E V T e h l e' h' l' T')
have IH:"⋀T'. ⟦P,E(V ↦ T) ⊢ (h, l(V := None)) √; P,E(V ↦ T),h ⊢ e : T'⟧
⟹ P,E(V ↦ T),h' ⊢ e' :⇘NT⇙ T'"
and sconf:"P,E ⊢ (h, l) √" and wt:"P,E,h ⊢ {V:T; e} : T'" by fact+
from wt have type:"is_type P T" and wte:"P,E(V↦T),h ⊢ e : T'" by auto
from sconf type have "P,E(V ↦ T) ⊢ (h, l(V := None)) √"
by (auto simp:sconf_def lconf_def envconf_def)
from IH[OF this wte] type show ?case by (cases T') auto
next
case (BlockRedSome E V T e h l e' h' l' v T')
have red:"P,E(V ↦ T) ⊢ ⟨e,(h, l(V := None))⟩ → ⟨e',(h', l')⟩"
and IH:"⋀T'. ⟦P,E(V ↦ T) ⊢ (h, l(V := None)) √; P,E(V ↦ T),h ⊢ e : T'⟧
⟹ P,E(V ↦ T),h' ⊢ e' :⇘NT⇙ T'"
and Some:"l' V = Some v"
and sconf:"P,E ⊢ (h, l) √" and wt:"P,E,h ⊢ {V:T; e} : T'" by fact+
from wt have wte:"P,E(V↦T),h ⊢ e : T'" and type:"is_type P T" by auto
with sconf wf red type have "P,h' ⊢ l' (:≤)⇩w E(V ↦ T)"
by -(auto simp:sconf_def,rule red_preserves_lconf,
auto intro:wf_prog_wwf_prog simp:envconf_def lconf_def)
hence conf:"P,h' ⊢ v :≤ T" using Some
by(auto simp:lconf_def,erule_tac x="V" in allE,clarsimp)
have wtval:"P,E(V ↦ T),h' ⊢ V:=Val v : T"
proof(cases T)
case Void with conf show ?thesis by auto
next
case Boolean with conf show ?thesis by auto
next
case Integer with conf show ?thesis by auto
next
case NT with conf show ?thesis by auto
next
case (Class C)
with conf have "P,E(V ↦ T),h' ⊢ Val v : T ∨ P,E(V ↦ T),h' ⊢ Val v : NT"
by auto
with Class show ?thesis by auto
qed
from sconf type have "P,E(V ↦ T) ⊢ (h, l(V := None)) √"
by (auto simp:sconf_def lconf_def envconf_def)
from IH[OF this wte] wtval type show ?case by(cases T') auto
next
case (InitBlockRed E V T e h l v' e' h' l' v'' v T')
have red:"P,E(V ↦ T) ⊢ ⟨e,(h, l(V ↦ v'))⟩ → ⟨e',(h', l')⟩"
and IH:"⋀T'. ⟦P,E(V ↦ T) ⊢ (h, l(V ↦ v')) √; P,E(V ↦ T),h ⊢ e : T'⟧
⟹ P,E(V ↦ T),h' ⊢ e' :⇘NT⇙ T'"
and Some:"l' V = Some v''" and casts:"P ⊢ T casts v to v'"
and sconf:"P,E ⊢ (h, l) √" and wt:"P,E,h ⊢ {V:T := Val v; e} : T'" by fact+
from wt have wte:"P,E(V ↦ T),h ⊢ e : T'" and wtval:"P,E(V ↦ T),h ⊢ V:=Val v : T"
and type:"is_type P T"
by auto
from wf casts wtval have "P,h ⊢ v' :≤ T"
by(fastforce intro!:casts_conf wf_prog_wwf_prog)
with sconf have lconf:"P,h ⊢ l(V ↦ v') (:≤)⇩w E(V ↦ T)"
by (fastforce intro!:lconf_upd2 simp:sconf_def)
from sconf type have "envconf P (E(V ↦ T))" by(simp add:sconf_def envconf_def)
from red_preserves_lconf[OF wf_prog_wwf_prog[OF wf] red wte lconf this]
have "P,h' ⊢ l' (:≤)⇩w E(V ↦ T)" .
with Some have "P,h' ⊢ v'' :≤ T"
by(simp add:lconf_def,erule_tac x="V" in allE,auto)
hence wtval':"P,E(V ↦ T),h' ⊢ V:=Val v'' : T"
by(cases T) auto
from lconf sconf type have "P,E(V ↦ T) ⊢ (h, l(V ↦ v')) √"
by(auto simp:sconf_def envconf_def)
from IH[OF this wte] wtval' type show ?case by(cases T') auto
next
case RedBlock thus ?case by (fastforce intro:wt_same_type_typeconf)
next
case RedInitBlock thus ?case by (fastforce intro:wt_same_type_typeconf)
next
case (SeqRed E e h l e' h' l' e⇩2 T)
have red:"P,E ⊢ ⟨e,(h, l)⟩ → ⟨e',(h', l')⟩"
and IH:"⋀T'. ⟦P,E ⊢ (h, l) √; P,E,h ⊢ e : T'⟧ ⟹ P,E,h' ⊢ e' :⇘NT⇙ T'"
and sconf:"P,E ⊢ (h, l) √" and wt:"P,E,h ⊢ e;; e⇩2 : T" by fact+
from wt obtain T' where wte:"P,E,h ⊢ e : T'" and wte2:"P,E,h ⊢ e⇩2 : T" by auto
from WTrt_hext_mono[OF wte2 red_hext_incr[OF red]] have wte2':"P,E,h' ⊢ e⇩2 : T" .
from IH[OF sconf wte] obtain T'' where "P,E,h' ⊢ e' : T''" by(cases T') auto
with wte2' have "P,E,h' ⊢ e';; e⇩2 : T" by auto
thus ?case by(rule wt_same_type_typeconf)
next
case RedSeq thus ?case by (fastforce intro:wt_same_type_typeconf)
next
case (CondRed E e h l e' h' l' e⇩1 e⇩2)
have red:"P,E ⊢ ⟨e,(h, l)⟩ → ⟨e',(h', l')⟩"
and IH: "⋀T. ⟦P,E ⊢ (h,l) √; P,E,h ⊢ e : T⟧
⟹ P,E,h' ⊢ e' :⇘NT⇙ T"
and wt:"P,E,h ⊢ if (e) e⇩1 else e⇩2 : T"
and sconf:"P,E ⊢ (h,l) √" by fact+
from wt have wte:"P,E,h ⊢ e : Boolean"
and wte1:"P,E,h ⊢ e⇩1 : T" and wte2:"P,E,h ⊢ e⇩2 : T" by auto
from IH[OF sconf wte] have wte':"P,E,h' ⊢ e' : Boolean" by auto
from wte' WTrt_hext_mono[OF wte1 red_hext_incr[OF red]]
WTrt_hext_mono[OF wte2 red_hext_incr[OF red]]
have "P,E,h' ⊢ if (e') e⇩1 else e⇩2 : T"
by (rule WTrtCond)
thus ?case by(rule wt_same_type_typeconf)
next
case RedCondT thus ?case by (fastforce intro: wt_same_type_typeconf)
next
case RedCondF thus ?case by (fastforce intro: wt_same_type_typeconf)
next
case RedWhile thus ?case by (fastforce intro: wt_same_type_typeconf)
next
case (ThrowRed E e h l e' h' l' T)
have IH:"⋀T. ⟦P,E ⊢ (h, l) √; P,E,h ⊢ e : T⟧ ⟹ P,E,h' ⊢ e' :⇘NT⇙ T"
and sconf:"P,E ⊢ (h, l) √" and wt:"P,E,h ⊢ throw e : T" by fact+
from wt obtain T' where wte:"P,E,h ⊢ e : T'" and ref:"is_refT T'"
by auto
from ref have "P,E,h' ⊢ throw e' : T"
proof(rule refTE)
assume T':"T' = NT"
with wte have "P,E,h ⊢ e : NT" by simp
from IH[OF sconf this] ref T' show ?thesis by auto
next
fix C assume T':"T' = Class C"
with wte have "P,E,h ⊢ e : Class C" by simp
from IH[OF sconf this] have "P,E,h' ⊢ e' : Class C ∨ P,E,h' ⊢ e' : NT"
by simp
thus ?thesis
proof(rule disjE)
assume wte':"P,E,h' ⊢ e' : Class C"
have "is_refT (Class C)" by simp
with wte' show ?thesis by auto
next
assume wte':"P,E,h' ⊢ e' : NT"
have "is_refT NT" by simp
with wte' show ?thesis by auto
qed
qed
thus ?case by (rule wt_same_type_typeconf)
next
case (RedThrowNull E h l)
have sconf:"P,E ⊢ (h, l) √" by fact
from wf have "is_class P NullPointer"
by (fastforce intro:is_class_xcpt wf_prog_wwf_prog)
hence "preallocated h ⟹ P ⊢ typeof⇘h⇙ (Ref (addr_of_sys_xcpt NullPointer,[NullPointer])) = Some(Class NullPointer)"
by (auto elim: preallocatedE dest!:preallocatedD Subobjs_Base)
with sconf have "P,E,h ⊢ THROW NullPointer : T" by(auto simp:sconf_def hconf_def)
thus ?case by (fastforce intro:wt_same_type_typeconf wf_prog_wwf_prog)
next
case (ListRed1 E e h l e' h' l' es Ts)
have red:"P,E ⊢ ⟨e,(h, l)⟩ → ⟨e',(h', l')⟩"
and IH:"⋀T. ⟦P,E ⊢ (h, l) √; P,E,h ⊢ e : T⟧ ⟹ P,E,h' ⊢ e' :⇘NT⇙ T"
and sconf:"P,E ⊢ (h, l) √" and wt:"P,E,h ⊢ e # es [:] Ts" by fact+
from wt obtain U Us where Ts:"Ts = U#Us" by(cases Ts) auto
with wt have wte:"P,E,h ⊢ e : U" and wtes:"P,E,h ⊢ es [:] Us" by simp_all
from WTrts_hext_mono[OF wtes red_hext_incr[OF red]]
have wtes':"P,E,h' ⊢ es [:] Us" .
hence "length es = length Us" by (rule WTrts_same_length)
with wtes' have "types_conf P E h' es Us"
by (fastforce intro:wts_same_types_typesconf)
with IH[OF sconf wte] Ts show ?case by simp
next
case (ListRed2 E es h l es' h' l' v Ts)
have reds:"P,E ⊢ ⟨es,(h, l)⟩ [→] ⟨es',(h', l')⟩"
and IH:"⋀Ts. ⟦P,E ⊢ (h, l) √; P,E,h ⊢ es [:] Ts⟧ ⟹ types_conf P E h' es' Ts"
and sconf:"P,E ⊢ (h, l) √" and wt:"P,E,h ⊢ Val v#es [:] Ts" by fact+
from wt obtain U Us where Ts:"Ts = U#Us" by(cases Ts) auto
with wt have wtval:"P,E,h ⊢ Val v : U" and wtes:"P,E,h ⊢ es [:] Us" by simp_all
from WTrt_hext_mono[OF wtval reds_hext_incr[OF reds]]
have "P,E,h' ⊢ Val v : U" .
hence "P,E,h' ⊢ (Val v) :⇘NT⇙ U" by(rule wt_same_type_typeconf)
with IH[OF sconf wtes] Ts show ?case by simp
next
case (CallThrowObj E h l Copt M es h' l')
thus ?case by(cases Copt)(auto intro:wt_same_type_typeconf)
next
case (CallThrowParams es vs h l es' E v Copt M h' l')
thus ?case by(cases Copt)(auto intro:wt_same_type_typeconf)
qed (fastforce intro:wt_same_type_typeconf)+
corollary subject_reduction:
"⟦ wf_C_prog P; P,E ⊢ ⟨e,s⟩ → ⟨e',s'⟩; P,E ⊢ s √; P,E,hp s ⊢ e:T ⟧
⟹ P,E,(hp s') ⊢ e' :⇘NT⇙ T"
by(cases s, cases s', fastforce dest:subject_reduction2)
corollary subjects_reduction:
"⟦ wf_C_prog P; P,E ⊢ ⟨es,s⟩ [→] ⟨es',s'⟩; P,E ⊢ s √; P,E,hp s ⊢ es[:]Ts ⟧
⟹ types_conf P E (hp s') es' Ts"
by(cases s, cases s', fastforce dest:subjects_reduction2)
subsection ‹Lifting to ‹→*››
text‹Now all these preservation lemmas are first lifted to the transitive
closure \dots›
lemma step_preserves_sconf:
assumes wf: "wf_C_prog P" and step: "P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩"
shows "⋀T. ⟦ P,E,hp s ⊢ e : T; P,E ⊢ s √ ⟧ ⟹ P,E ⊢ s' √"
using step
proof (induct rule:converse_rtrancl_induct2)
case refl show ?case by fact
next
case step
thus ?case using wf
apply simp
apply (frule subject_reduction[OF wf])
apply (rule step.prems)
apply (rule step.prems)
apply (cases T)
apply (auto dest:red_preserves_sconf intro:wf_prog_wwf_prog)
done
qed
lemma steps_preserves_sconf:
assumes wf: "wf_C_prog P" and step: "P,E ⊢ ⟨es,s⟩ [→]* ⟨es',s'⟩"
shows "⋀Ts. ⟦ P,E,hp s ⊢ es [:] Ts; P,E ⊢ s √ ⟧ ⟹ P,E ⊢ s' √"
using step
proof (induct rule:converse_rtrancl_induct2)
case refl show ?case by fact
next
case (step es s es'' s'' Ts)
have Reds:"((es, s), es'', s'') ∈ Reds P E"
and reds:"P,E ⊢ ⟨es'',s''⟩ [→]* ⟨es',s'⟩"
and wtes:"P,E,hp s ⊢ es [:] Ts"
and sconf:"P,E ⊢ s √"
and IH:"⋀Ts. ⟦P,E,hp s'' ⊢ es'' [:] Ts; P,E ⊢ s'' √⟧ ⟹ P,E ⊢ s' √" by fact+
from Reds have reds1:"P,E ⊢ ⟨es,s⟩ [→] ⟨es'',s''⟩" by simp
from subjects_reduction[OF wf this sconf wtes]
have type:"types_conf P E (hp s'') es'' Ts" .
from reds1 wtes sconf wf have sconf':"P,E ⊢ s'' √"
by(fastforce intro:wf_prog_wwf_prog reds_preserves_sconf)
from type have "∃Ts'. P,E,hp s'' ⊢ es'' [:] Ts'"
proof (induct Ts arbitrary: es'')
fix esi
assume "types_conf P E (hp s'') esi []"
thus "∃Ts'. P,E,hp s'' ⊢ esi [:] Ts'"
proof(induct esi)
case Nil thus "∃Ts'. P,E,hp s'' ⊢ [] [:] Ts'" by simp
next
fix ex esx
assume "types_conf P E (hp s'') (ex#esx) []"
thus "∃Ts'. P,E,hp s'' ⊢ ex#esx [:] Ts'" by simp
qed
next
fix T' Ts' esi
assume type':"types_conf P E (hp s'') esi (T'#Ts')"
and IH:"⋀es''. types_conf P E (hp s'') es'' Ts' ⟹
∃Ts''. P,E,hp s'' ⊢ es'' [:] Ts''"
from type' show "∃Ts'. P,E,hp s'' ⊢ esi [:] Ts'"
proof(induct esi)
case Nil thus "∃Ts'. P,E,hp s'' ⊢ [] [:] Ts'" by simp
next
fix ex esx
assume "types_conf P E (hp s'') (ex#esx) (T'#Ts')"
hence type':"P,E,hp s'' ⊢ ex :⇘NT⇙ T'"
and types':"types_conf P E (hp s'') esx Ts'" by simp_all
from type' obtain Tx where type'':"P,E,hp s'' ⊢ ex : Tx"
by(cases T') auto
from IH[OF types'] obtain Tsx where "P,E,hp s'' ⊢ esx [:] Tsx" by auto
with type'' show "∃Ts'. P,E,hp s'' ⊢ ex#esx [:] Ts'" by auto
qed
qed
then obtain Ts' where "P,E,hp s'' ⊢ es'' [:] Ts'" by blast
from IH[OF this sconf'] show ?case .
qed
lemma step_preserves_defass:
assumes wf: "wf_C_prog P" and step: "P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩"
shows "𝒟 e ⌊dom(lcl s)⌋ ⟹ 𝒟 e' ⌊dom(lcl s')⌋"
using step
proof (induct rule:converse_rtrancl_induct2)
case refl thus ?case .
next
case (step e s e' s') thus ?case
by(cases s,cases s')(auto dest:red_preserves_defass[OF wf])
qed
lemma step_preserves_type:
assumes wf: "wf_C_prog P" and step: "P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩"
shows "⋀T. ⟦ P,E ⊢ s √; P,E,hp s ⊢ e:T ⟧
⟹ P,E,(hp s') ⊢ e' :⇘NT⇙ T"
using step
proof (induct rule:converse_rtrancl_induct2)
case refl thus ?case by -(rule wt_same_type_typeconf)
next
case (step e s e'' s'' T) thus ?case using wf
apply simp
apply (frule subject_reduction[OF wf])
apply (auto dest!:red_preserves_sconf intro:wf_prog_wwf_prog)
apply(cases T)
apply fastforce+
done
qed
text‹predicate to show the same lemma for lists›
fun
conformable :: "ty list ⇒ ty list ⇒ bool"
where
"conformable [] [] ⟷ True"
| "conformable (T''#Ts'') (T'#Ts') ⟷ (T'' = T'
∨ (∃C. T'' = NT ∧ T' = Class C)) ∧ conformable Ts'' Ts'"
| "conformable _ _ ⟷ False"
lemma types_conf_conf_types_conf:
"⟦types_conf P E h es Ts; conformable Ts Ts'⟧ ⟹ types_conf P E h es Ts'"
proof (induct Ts arbitrary: Ts' es)
case Nil thus ?case by (cases Ts') (auto split: if_split_asm)
next
case (Cons T'' Ts'')
have type:"types_conf P E h es (T''#Ts'')"
and conf:"conformable (T''#Ts'') Ts'"
and IH:"⋀Ts' es. ⟦types_conf P E h es Ts''; conformable Ts'' Ts'⟧
⟹ types_conf P E h es Ts'" by fact+
from type obtain e' es' where es:"es = e'#es'" by (cases es) auto
with type have type':"P,E,h ⊢ e' :⇘NT⇙ T''"
and types': "types_conf P E h es' Ts''"
by simp_all
from conf obtain U Us where Ts': "Ts' = U#Us" by (cases Ts') auto
with conf have disj:"T'' = U ∨ (∃C. T'' = NT ∧ U = Class C)"
and conf':"conformable Ts'' Us"
by simp_all
from type' disj have "P,E,h ⊢ e' :⇘NT⇙ U" by auto
with IH[OF types' conf'] Ts' es show ?case by simp
qed
lemma types_conf_Wtrt_conf:
"types_conf P E h es Ts ⟹ ∃Ts'. P,E,h ⊢ es [:] Ts' ∧ conformable Ts' Ts"
proof (induct Ts arbitrary: es)
case Nil thus ?case by (cases es) (auto split:if_split_asm)
next
case (Cons T'' Ts'')
have type:"types_conf P E h es (T''#Ts'')"
and IH:"⋀es. types_conf P E h es Ts'' ⟹
∃Ts'. P,E,h ⊢ es [:] Ts' ∧ conformable Ts' Ts''" by fact+
from type obtain e' es' where es:"es = e'#es'" by (cases es) auto
with type have type':"P,E,h ⊢ e' :⇘NT⇙ T''"
and types': "types_conf P E h es' Ts''"
by simp_all
from type' obtain T' where "P,E,h ⊢ e' : T'" and
"T' = T'' ∨ (∃C. T' = NT ∧ T'' = Class C)" by(cases T'') auto
with IH[OF types'] es show ?case
by(auto,rule_tac x="T''#Ts'" in exI,simp,rule_tac x="NT#Ts'" in exI,simp)
qed
lemma steps_preserves_types:
assumes wf: "wf_C_prog P" and steps: "P,E ⊢ ⟨es,s⟩ [→]* ⟨es',s'⟩"
shows "⋀Ts. ⟦ P,E ⊢ s √; P,E,hp s ⊢ es [:] Ts⟧
⟹ types_conf P E (hp s') es' Ts"
using steps
proof (induct rule:converse_rtrancl_induct2)
case refl thus ?case by -(rule wts_same_types_typesconf)
next
case (step es s es'' s'' Ts)
have Reds:"((es, s), es'', s'') ∈ Reds P E"
and steps:"P,E ⊢ ⟨es'',s''⟩ [→]* ⟨es',s'⟩"
and sconf:"P,E ⊢ s √" and wtes:"P,E,hp s ⊢ es [:] Ts"
and IH:"⋀Ts. ⟦P,E ⊢ s'' √; P,E,hp s'' ⊢ es'' [:] Ts ⟧
⟹ types_conf P E (hp s') es' Ts" by fact+
from Reds have step:"P,E ⊢ ⟨es,s⟩ [→] ⟨es'',s''⟩" by simp
with wtes sconf wf have sconf':"P,E ⊢ s'' √"
by(auto intro:reds_preserves_sconf wf_prog_wwf_prog)
from wtes have "length es = length Ts" by(fastforce dest:WTrts_same_length)
from step sconf wtes
have type': "types_conf P E (hp s'') es'' Ts"
by (rule subjects_reduction[OF wf])
then obtain Ts' where wtes'':"P,E,hp s'' ⊢ es'' [:] Ts'"
and conf:"conformable Ts' Ts" by (auto dest:types_conf_Wtrt_conf)
from IH[OF sconf' wtes''] have "types_conf P E (hp s') es' Ts'" .
with conf show ?case by(fastforce intro:types_conf_conf_types_conf)
qed
subsection ‹Lifting to ‹⇒››
text‹\dots and now to the big step semantics, just for fun.›
lemma eval_preserves_sconf:
"⟦ wf_C_prog P; P,E ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩; P,E ⊢ e::T; P,E ⊢ s √ ⟧ ⟹ P,E ⊢ s' √"
by(blast intro:step_preserves_sconf big_by_small WT_implies_WTrt wf_prog_wwf_prog)
lemma evals_preserves_sconf:
"⟦ wf_C_prog P; P,E ⊢ ⟨es,s⟩ [⇒] ⟨es',s'⟩; P,E ⊢ es [::] Ts; P,E ⊢ s √ ⟧
⟹ P,E ⊢ s' √"
by(blast intro:steps_preserves_sconf bigs_by_smalls WTs_implies_WTrts
wf_prog_wwf_prog)
lemma eval_preserves_type: assumes wf: "wf_C_prog P"
shows "⟦ P,E ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩; P,E ⊢ s √; P,E ⊢ e::T ⟧
⟹ P,E,(hp s') ⊢ e' :⇘NT⇙ T"
using wf
by (auto dest!:big_by_small[OF wf_prog_wwf_prog[OF wf]] WT_implies_WTrt
intro:wf_prog_wwf_prog
dest!:step_preserves_type[OF wf])
lemma evals_preserves_types: assumes wf: "wf_C_prog P"
shows "⟦ P,E ⊢ ⟨es,s⟩ [⇒] ⟨es',s'⟩; P,E ⊢ s √; P,E ⊢ es [::] Ts ⟧
⟹ types_conf P E (hp s') es' Ts"
using wf
by (auto dest!:bigs_by_smalls[OF wf_prog_wwf_prog[OF wf]] WTs_implies_WTrts
intro:wf_prog_wwf_prog
dest!:steps_preserves_types[OF wf])
subsection ‹The final polish›
text‹The above preservation lemmas are now combined and packed nicely.›
definition wf_config :: "prog ⇒ env ⇒ state ⇒ expr ⇒ ty ⇒ bool" ("_,_,_ ⊢ _ : _ √" [51,0,0,0,0]50) where
"P,E,s ⊢ e:T √ ≡ P,E ⊢ s √ ∧ P,E,hp s ⊢ e : T"
theorem Subject_reduction: assumes wf: "wf_C_prog P"
shows "P,E ⊢ ⟨e,s⟩ → ⟨e',s'⟩ ⟹ P,E,s ⊢ e : T √
⟹ P,E,(hp s') ⊢ e' :⇘NT⇙ T"
using wf
by (force elim!:red_preserves_sconf intro:wf_prog_wwf_prog
dest:subject_reduction[OF wf] simp:wf_config_def)
theorem Subject_reductions:
assumes wf: "wf_C_prog P" and reds: "P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩"
shows "⋀T. P,E,s ⊢ e : T √ ⟹ P,E,(hp s') ⊢ e' :⇘NT⇙ T"
using reds
proof (induct rule:converse_rtrancl_induct2)
case refl thus ?case
by (fastforce intro:wt_same_type_typeconf simp:wf_config_def)
next
case (step e s e'' s'' T)
have Red:"((e, s), e'', s'') ∈ Red P E"
and IH:"⋀T. P,E,s'' ⊢ e'' : T √ ⟹ P,E,(hp s') ⊢ e' :⇘NT⇙ T"
and wte:"P,E,s ⊢ e : T √" by fact+
from Red have red:"P,E ⊢ ⟨e,s⟩ → ⟨e'',s''⟩" by simp
from red_preserves_sconf[OF red] wte wf have sconf:"P,E ⊢ s'' √"
by(fastforce dest:wf_prog_wwf_prog simp:wf_config_def)
from wf red wte have type_conf:"P,E,(hp s'') ⊢ e'' :⇘NT⇙ T"
by(rule Subject_reduction)
show ?case
proof(cases T)
case Void
with type_conf have "P,E,hp s'' ⊢ e'' : T" by simp
with sconf have "P,E,s'' ⊢ e'' : T √" by(simp add:wf_config_def)
from IH[OF this] show ?thesis .
next
case Boolean
with type_conf have "P,E,hp s'' ⊢ e'' : T" by simp
with sconf have "P,E,s'' ⊢ e'' : T √" by(simp add:wf_config_def)
from IH[OF this] show ?thesis .
next
case Integer
with type_conf have "P,E,hp s'' ⊢ e'' : T" by simp
with sconf have "P,E,s'' ⊢ e'' : T √" by(simp add:wf_config_def)
from IH[OF this] show ?thesis .
next
case NT
with type_conf have "P,E,hp s'' ⊢ e'' : T" by simp
with sconf have "P,E,s'' ⊢ e'' : T √" by(simp add:wf_config_def)
from IH[OF this] show ?thesis .
next
case (Class C)
with type_conf have "P,E,hp s'' ⊢ e'' : T ∨ P,E,hp s'' ⊢ e'' : NT" by simp
thus ?thesis
proof(rule disjE)
assume "P,E,hp s'' ⊢ e'' : T"
with sconf have "P,E,s'' ⊢ e'' : T √" by(simp add:wf_config_def)
from IH[OF this] show ?thesis .
next
assume "P,E,hp s'' ⊢ e'' : NT"
with sconf have "P,E,s'' ⊢ e'' : NT √" by(simp add:wf_config_def)
from IH[OF this] have "P,E,hp s' ⊢ e' : NT" by simp
with Class show ?thesis by simp
qed
qed
qed
corollary Progress: assumes wf: "wf_C_prog P"
shows "⟦ P,E,s ⊢ e : T √; 𝒟 e ⌊dom(lcl s)⌋; ¬ final e ⟧ ⟹ ∃e' s'. P,E ⊢ ⟨e,s⟩ → ⟨e',s'⟩"
using progress[OF wf_prog_wwf_prog[OF wf]]
by(auto simp:wf_config_def sconf_def)
corollary TypeSafety:
fixes s s' :: state
assumes wf:"wf_C_prog P" and sconf:"P,E ⊢ s √" and wte:"P,E ⊢ e :: T"
and D:"𝒟 e ⌊dom(lcl s)⌋" and step:"P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩"
and nored:"¬(∃e'' s''. P,E ⊢ ⟨e',s'⟩ → ⟨e'',s''⟩)"
shows "(∃v. e' = Val v ∧ P,hp s' ⊢ v :≤ T) ∨
(∃r. e' = Throw r ∧ the_addr (Ref r) ∈ dom(hp s'))"
proof -
from sconf wte wf have wf_config:"P,E,s ⊢ e : T √"
by(fastforce intro:WT_implies_WTrt simp:wf_config_def)
with wf step have type_conf:"P,E,(hp s') ⊢ e' :⇘NT⇙ T"
by(rule Subject_reductions)
from step_preserves_sconf[OF wf step wte[THEN WT_implies_WTrt] sconf] wf
have sconf':"P,E ⊢ s' √" by simp
from wf step D have D':"𝒟 e' ⌊dom(lcl s')⌋" by(rule step_preserves_defass)
show ?thesis
proof(cases T)
case Void
with type_conf have wte':"P,E,hp s' ⊢ e' : T" by simp
with sconf' have wf_config':"P,E,s' ⊢ e' : T √" by(simp add:wf_config_def)
{ assume "¬ final e'"
from Progress[OF wf wf_config' D' this] nored have False
by simp }
hence "final e'" by fast
with wte' show ?thesis by(auto simp:final_def)
next
case Boolean
with type_conf have wte':"P,E,hp s' ⊢ e' : T" by simp
with sconf' have wf_config':"P,E,s' ⊢ e' : T √" by(simp add:wf_config_def)
{ assume "¬ final e'"
from Progress[OF wf wf_config' D' this] nored have False
by simp }
hence "final e'" by fast
with wte' show ?thesis by(auto simp:final_def)
next
case Integer
with type_conf have wte':"P,E,hp s' ⊢ e' : T" by simp
with sconf' have wf_config':"P,E,s' ⊢ e' : T √" by(simp add:wf_config_def)
{ assume "¬ final e'"
from Progress[OF wf wf_config' D' this] nored have False
by simp }
hence "final e'" by fast
with wte' show ?thesis by(auto simp:final_def)
next
case NT
with type_conf have wte':"P,E,hp s' ⊢ e' : T" by simp
with sconf' have wf_config':"P,E,s' ⊢ e' : T √" by(simp add:wf_config_def)
{ assume "¬ final e'"
from Progress[OF wf wf_config' D' this] nored have False
by simp }
hence "final e'" by fast
with wte' show ?thesis by(auto simp:final_def)
next
case (Class C)
with type_conf have wte':"P,E,hp s' ⊢ e' : T ∨ P,E,hp s' ⊢ e' : NT" by simp
thus ?thesis
proof(rule disjE)
assume wte':"P,E,hp s' ⊢ e' : T"
with sconf' have wf_config':"P,E,s' ⊢ e' : T √" by(simp add:wf_config_def)
{ assume "¬ final e'"
from Progress[OF wf wf_config' D' this] nored have False
by simp }
hence "final e'" by fast
with wte' show ?thesis by(auto simp:final_def)
next
assume wte':"P,E,hp s' ⊢ e' : NT"
with sconf' have wf_config':"P,E,s' ⊢ e' : NT √" by(simp add:wf_config_def)
{ assume "¬ final e'"
from Progress[OF wf wf_config' D' this] nored have False
by simp }
hence "final e'" by fast
with wte' Class show ?thesis by(auto simp:final_def)
qed
qed
qed
end
Theory Determinism
section ‹Determinism Proof›
theory Determinism
imports TypeSafe
begin
subsection‹Some lemmas›
lemma maps_nth:
"⟦(E(xs [↦] ys)) x = Some y; length xs = length ys; distinct xs⟧
⟹ ∀i. x = xs!i ∧ i < length xs ⟶ y = ys!i"
proof (induct xs arbitrary: ys E)
case Nil thus ?case by simp
next
case (Cons x' xs')
have map:"(E(x' # xs' [↦] ys)) x = Some y"
and length:"length (x'#xs') = length ys"
and dist:"distinct (x'#xs')"
and IH:"⋀ys E. ⟦(E(xs' [↦] ys)) x = Some y; length xs' = length ys;
distinct xs'⟧
⟹ ∀i. x = xs'!i ∧ i < length xs' ⟶ y = ys!i" by fact+
from length obtain y' ys' where ys:"ys = y'#ys'" by(cases ys) auto
{ fix i assume x:"x = (x'#xs')!i" and i:"i < length(x'#xs')"
have "y = ys!i"
proof(cases i)
case 0 with x map ys dist show ?thesis by simp
next
case (Suc n)
with x i have x':"x = xs'!n" and n:"n < length xs'" by simp_all
from map ys have map':"(E(x' ↦ y')(xs' [↦] ys')) x = Some y" by simp
from length ys have length':"length xs' = length ys'" by simp
from dist have dist':"distinct xs'" by simp
from IH[OF map' length' dist']
have "∀i. x = xs'!i ∧ i < length xs' ⟶ y = ys'!i" .
with x' n have "y = ys'!n" by simp
with ys n Suc show ?thesis by simp
qed }
thus ?case by simp
qed
lemma nth_maps:"⟦length pns = length Ts; distinct pns; i < length Ts⟧
⟹ (E(pns [↦] Ts)) (pns!i) = Some (Ts!i)"
proof (induct i arbitrary: E pns Ts)
case 0
have dist:"distinct pns" and length:"length pns = length Ts"
and i_length:"0 < length Ts" by fact+
from i_length obtain T' Ts' where Ts:"Ts = T'#Ts'" by(cases Ts) auto
with length obtain p' pns' where "pns = p'#pns'" by(cases pns) auto
with Ts dist show ?case by simp
next
case (Suc n)
have i_length:"Suc n < length Ts" and dist:"distinct pns"
and length:"length pns = length Ts" by fact+
from Suc obtain T' Ts' where Ts:"Ts = T'#Ts'" by(cases Ts) auto
with length obtain p' pns' where pns:"pns = p'#pns'" by(cases pns) auto
with Ts length dist have length':"length pns' = length Ts'"
and dist':"distinct pns'" and notin:"p' ∉ set pns'" by simp_all
from i_length Ts have n_length:"n < length Ts'" by simp
with length' dist' have map:"(E(p' ↦ T')(pns' [↦] Ts')) (pns'!n) = Some(Ts'!n)" by fact
with notin have "(E(p' ↦ T')(pns' [↦] Ts')) p' = Some T'" by simp
with pns Ts map show ?case by simp
qed
lemma casts_casts_eq_result:
fixes s :: state
assumes casts:"P ⊢ T casts v to v'" and casts':"P ⊢ T casts v to w'"
and type:"is_type P T" and wte:"P,E ⊢ e :: T'" and leq:"P ⊢ T' ≤ T"
and eval:"P,E ⊢ ⟨e,s⟩ ⇒ ⟨Val v,(h,l)⟩" and sconf:"P,E ⊢ s √"
and wf:"wf_C_prog P"
shows "v' = w'"
proof(cases "∀C. T ≠ Class C")
case True
with casts casts' show ?thesis
by(auto elim:casts_to.cases)
next
case False
then obtain C where T:"T = Class C" by auto
with type have "is_class P C" by simp
with wf T leq have "T' = NT ∨ (∃D. T' = Class D ∧ P ⊢ Path D to C unique)"
by(simp add:widen_Class)
thus ?thesis
proof(rule disjE)
assume "T' = NT"
with wf eval sconf wte have "v = Null"
by(fastforce dest:eval_preserves_type)
with casts casts' show ?thesis by(fastforce elim:casts_to.cases)
next
assume "∃D. T' = Class D ∧ P ⊢ Path D to C unique"
then obtain D where T':"T' = Class D"
and path_unique:"P ⊢ Path D to C unique" by auto
with wf eval sconf wte
have "P,E,h ⊢ Val v : T' ∨ P,E,h ⊢ Val v : NT"
by(fastforce dest:eval_preserves_type)
thus ?thesis
proof(rule disjE)
assume "P,E,h ⊢ Val v : T'"
with T' obtain a Cs C' S where h:"h a = Some(C',S)" and v:"v = Ref(a,Cs)"
and last:"last Cs = D"
by(fastforce dest:typeof_Class_Subo)
from casts' v last T obtain Cs' Ds where "P ⊢ Path D to C via Cs'"
and "Ds = Cs@⇩pCs'" and "w' = Ref(a,Ds)"
by(auto elim:casts_to.cases)
with casts T v last path_unique show ?thesis
by auto(erule casts_to.cases,auto simp:path_via_def path_unique_def)
next
assume "P,E,h ⊢ Val v : NT"
with wf eval sconf wte have "v = Null"
by(fastforce dest:eval_preserves_type)
with casts casts' show ?thesis by(fastforce elim:casts_to.cases)
qed
qed
qed
lemma Casts_Casts_eq_result:
assumes wf:"wf_C_prog P"
shows "⟦P ⊢ Ts Casts vs to vs'; P ⊢ Ts Casts vs to ws'; ∀T ∈ set Ts. is_type P T;
P,E ⊢ es [::] Ts'; P ⊢ Ts' [≤] Ts; P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val vs,(h,l)⟩;
P,E ⊢ s √⟧
⟹ vs' = ws'"
proof (induct vs arbitrary: vs' ws' Ts Ts' es s)
case Nil thus ?case by (auto elim!:Casts_to.cases)
next
case (Cons x xs)
have CastsCons:"P ⊢ Ts Casts x # xs to vs'"
and CastsCons':"P ⊢ Ts Casts x # xs to ws'"
and type:"∀T ∈ set Ts. is_type P T"
and wtes:"P,E ⊢ es [::] Ts'" and subs:"P ⊢ Ts' [≤] Ts"
and evals:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val (x#xs),(h,l)⟩"
and sconf:"P,E ⊢ s √"
and IH:"⋀vs' ws' Ts Ts' es s.
⟦P ⊢ Ts Casts xs to vs'; P ⊢ Ts Casts xs to ws'; ∀T ∈ set Ts. is_type P T;
P,E ⊢ es [::] Ts'; P ⊢ Ts' [≤] Ts; P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val xs,(h,l)⟩;
P,E ⊢ s √⟧
⟹ vs' = ws'" by fact+
from CastsCons obtain y ys S Ss where vs':"vs' = y#ys" and Ts:"Ts = S#Ss"
apply -
apply(frule length_Casts_vs,cases Ts,auto)
apply(frule length_Casts_vs',cases vs',auto)
done
with CastsCons have casts:"P ⊢ S casts x to y" and Casts:"P ⊢ Ss Casts xs to ys"
by(auto elim:Casts_to.cases)
from Ts type have type':"is_type P S" and types':"∀T ∈ set Ss. is_type P T"
by auto
from Ts CastsCons' obtain z zs where ws':"ws' = z#zs"
by simp(frule length_Casts_vs',cases ws',auto)
with Ts CastsCons' have casts':"P ⊢ S casts x to z"
and Casts':"P ⊢ Ss Casts xs to zs"
by(auto elim:Casts_to.cases)
from Ts subs obtain U Us where Ts':"Ts' = U#Us" and subs':"P ⊢ Us [≤] Ss"
and sub:"P ⊢ U ≤ S" by(cases Ts',auto simp:fun_of_def)
from wtes Ts' obtain e' es' where es:"es = e'#es'" and wte':"P,E ⊢ e' :: U"
and wtes':"P,E ⊢ es' [::] Us" by(cases es) auto
with evals obtain h' l' where eval:"P,E ⊢ ⟨e',s⟩ ⇒ ⟨Val x,(h',l')⟩"
and evals':"P,E ⊢ ⟨es',(h',l')⟩ [⇒] ⟨map Val xs,(h,l)⟩"
by (auto elim:evals.cases)
from wf eval wte' sconf have "P,E ⊢ (h',l') √" by(rule eval_preserves_sconf)
from IH[OF Casts Casts' types' wtes' subs' evals' this] have eq:"ys = zs" .
from casts casts' type' wte' sub eval sconf wf have "y = z"
by(rule casts_casts_eq_result)
with eq vs' ws' show ?case by simp
qed
lemma Casts_conf: assumes wf: "wf_C_prog P"
shows "P ⊢ Ts Casts vs to vs' ⟹
(⋀es s Ts'. ⟦ P,E ⊢ es [::] Ts'; P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val vs,(h,l)⟩; P,E ⊢ s √;
P ⊢ Ts' [≤] Ts⟧ ⟹
∀i < length Ts. P,h ⊢ vs'!i :≤ Ts!i)"
proof(induct rule:Casts_to.induct)
case Casts_Nil thus ?case by simp
next
case (Casts_Cons T v v' Ts vs vs')
have casts:"P ⊢ T casts v to v'" and wtes:"P,E ⊢ es [::] Ts'"
and evals:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val (v#vs),(h,l)⟩"
and subs:"P ⊢ Ts' [≤] (T#Ts)" and sconf:"P,E ⊢ s √"
and IH:"⋀es s Ts'.⟦P,E ⊢ es [::] Ts'; P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val vs,(h,l)⟩;
P,E ⊢ s √; P ⊢ Ts' [≤] Ts⟧
⟹ ∀i<length Ts. P,h ⊢ vs' ! i :≤ Ts ! i" by fact+
from subs obtain U Us where Ts':"Ts' = U#Us" by(cases Ts') auto
with subs have sub':"P ⊢ U ≤ T" and subs':"P ⊢ Us [≤] Ts"
by (simp_all add:fun_of_def)
from wtes Ts' obtain e' es' where es:"es = e'#es'" by(cases es) auto
with Ts' wtes have wte':"P,E ⊢ e' :: U" and wtes':"P,E ⊢ es' [::] Us" by auto
from es evals obtain s' where eval':"P,E ⊢ ⟨e',s⟩ ⇒ ⟨Val v,s'⟩"
and evals':"P,E ⊢ ⟨es',s'⟩ [⇒] ⟨map Val vs,(h,l)⟩"
by(auto elim:evals.cases)
from wf eval' wte' sconf have sconf':"P,E ⊢ s' √" by(rule eval_preserves_sconf)
from evals' have hext:"hp s' ⊴ h" by(cases s',auto intro:evals_hext)
from wf eval' sconf wte' have "P,E,(hp s') ⊢ Val v :⇘NT⇙ U"
by(rule eval_preserves_type)
with hext have wtrt:"P,E,h ⊢ Val v :⇘NT⇙ U"
by(cases U,auto intro:hext_typeof_mono)
from casts wtrt sub' have "P,h ⊢ v' :≤ T"
proof(induct rule:casts_to.induct)
case (casts_prim T'' v'')
have "∀C. T'' ≠ Class C" and "P,E,h ⊢ Val v'' :⇘NT⇙ U" and "P ⊢ U ≤ T''" by fact+
thus ?case by(cases T'') auto
next
case (casts_null C) thus ?case by simp
next
case (casts_ref Cs C Cs' Ds a)
have path:"P ⊢ Path last Cs to C via Cs'"
and Ds:"Ds = Cs @⇩p Cs'"
and wtref:"P,E,h ⊢ ref (a, Cs) :⇘NT⇙ U" by fact+
from wtref obtain D S where subo:"Subobjs P D Cs" and h:"h a = Some(D,S)"
by(cases U,auto split:if_split_asm)
from path Ds have last:"C = last Ds"
by(fastforce intro!:appendPath_last Subobjs_nonempty simp:path_via_def)
from subo path Ds wf have "Subobjs P D Ds"
by(fastforce intro:Subobjs_appendPath simp:path_via_def)
with last h show ?case by simp
qed
with IH[OF wtes' evals' sconf' subs'] show ?case
by(auto simp:nth_Cons,case_tac i,auto)
qed
lemma map_Val_throw_False:"map Val vs = map Val ws @ throw ex # es ⟹ False"
proof (induct vs arbitrary: ws)
case Nil thus ?case by simp
next
case (Cons v' vs')
have eq:"map Val (v'#vs') = map Val ws @ throw ex # es"
and IH:"⋀ws'. map Val vs' = map Val ws' @ throw ex # es ⟹ False" by fact+
from eq obtain w' ws' where ws:"ws = w'#ws'" by(cases ws) auto
from eq have "tl(map Val (v'#vs')) = tl(map Val ws @ throw ex # es)" by simp
hence "map Val vs' = tl(map Val ws @ throw ex # es)" by simp
with ws have "map Val vs' = map Val ws' @ throw ex # es" by simp
from IH[OF this] show ?case .
qed
lemma map_Val_throw_eq:"map Val vs @ throw ex # es = map Val ws @ throw ex' # es'
⟹ vs = ws ∧ ex = ex' ∧ es = es'"
apply(clarsimp simp:append_eq_append_conv2)
apply(erule disjE)
apply(case_tac us)
apply(fastforce elim:map_injective simp:inj_on_def)
apply(fastforce dest:map_Val_throw_False)
apply(case_tac us)
apply(fastforce elim:map_injective simp:inj_on_def)
apply(fastforce dest:sym[THEN map_Val_throw_False])
done
subsection ‹The proof›
lemma deterministic_big_step:
assumes wf:"wf_C_prog P"
shows "P,E ⊢ ⟨e,s⟩ ⇒ ⟨e⇩1,s⇩1⟩ ⟹
(⋀e⇩2 s⇩2 T. ⟦P,E ⊢ ⟨e,s⟩ ⇒ ⟨e⇩2,s⇩2⟩; P,E ⊢ e :: T; P,E ⊢ s √⟧
⟹ e⇩1 = e⇩2 ∧ s⇩1 = s⇩2)"
and "P,E ⊢ ⟨es,s⟩ [⇒] ⟨es⇩1,s⇩1⟩ ⟹
(⋀es⇩2 s⇩2 Ts. ⟦P,E ⊢ ⟨es,s⟩ [⇒] ⟨es⇩2,s⇩2⟩; P,E ⊢ es [::] Ts; P,E ⊢ s √⟧
⟹ es⇩1 = es⇩2 ∧ s⇩1 = s⇩2)"
proof (induct rule:eval_evals.inducts)
case New thus ?case by(auto elim: eval_cases)
next
case NewFail thus ?case by(auto elim: eval_cases)
next
case (StaticUpCast E e s⇩0 a Cs s⇩1 C Cs' Ds e⇩2 s⇩2)
have eval:"P,E ⊢ ⟨⦇C⦈e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩"
and path_via:"P ⊢ Path last Cs to C via Cs'" and Ds:"Ds = Cs @⇩p Cs'"
and wt:"P,E ⊢ ⦇C⦈e :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH:"⋀e⇩2 s⇩2 T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ ref (a,Cs) = e⇩2 ∧ s⇩1 = s⇩2" by fact+
from wt obtain D where "class":"is_class P C" and wte:"P,E ⊢ e :: Class D"
and disj:"P ⊢ Path D to C unique ∨
(P ⊢ C ≼⇧* D ∧ (∀Cs. P ⊢ Path C to D via Cs ⟶ Subobjs⇩R P C Cs))"
by auto
from eval show ?case
proof(rule eval_cases)
fix Xs Xs' a'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref (a',Xs),s⇩2⟩"
and path_via':"P ⊢ Path last Xs to C via Xs'"
and ref:"e⇩2 = ref (a',Xs@⇩pXs')"
from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs = Xs ∧ s⇩1 = s⇩2" by simp
with wf eval_ref sconf wte have last:"last Cs = D"
by(auto dest:eval_preserves_type split:if_split_asm)
from disj show "ref (a,Ds) = e⇩2 ∧ s⇩1 = s⇩2"
proof (rule disjE)
assume "P ⊢ Path D to C unique"
with path_via path_via' eq last have "Cs' = Xs'"
by(fastforce simp add:path_via_def path_unique_def)
with eq ref Ds show ?thesis by simp
next
assume "P ⊢ C ≼⇧* D ∧ (∀Cs. P ⊢ Path C to D via Cs ⟶ Subobjs⇩R P C Cs)"
with "class" wf obtain Cs'' where "P ⊢ Path C to D via Cs''"
by(auto dest:leq_implies_path)
with path_via path_via' wf eq last have "Cs' = Xs'"
by(auto dest:path_via_reverse)
with eq ref Ds show ?thesis by simp
qed
next
fix Xs Xs' a'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs@C#Xs'),s⇩2⟩"
and ref:"e⇩2 = ref (a',Xs@[C])"
from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs = Xs@C#Xs' ∧ s⇩1 = s⇩2" by simp
with wf eval_ref sconf wte obtain C' where
last:"last Cs = D" and "Subobjs P C' (Xs@C#Xs')"
by(auto dest:eval_preserves_type split:if_split_asm)
hence subo:"Subobjs P C (C#Xs')" by(fastforce intro:Subobjs_Subobjs)
with eq last have leq:"P ⊢ C ≼⇧* D" by(fastforce dest:Subobjs_subclass)
from path_via last have "P ⊢ D ≼⇧* C"
by(auto dest:Subobjs_subclass simp:path_via_def)
with leq wf have CeqD:"C = D" by(rule subcls_asym2)
with last path_via wf have "Cs' = [D]" by(fastforce intro:path_via_C)
with Ds last have Ds':"Ds = Cs" by(simp add:appendPath_def)
from subo CeqD last eq wf have "Xs' = []" by(auto dest:mdc_eq_last)
with eq Ds' ref show "ref (a,Ds) = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
assume eval_null:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⇩2⟩"
from IH[OF eval_null wte sconf] show "ref (a,Ds) = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix Xs a'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs),s⇩2⟩" and notin:"C ∉ set Xs"
and notleq:"¬ P ⊢ last Xs ≼⇧* C" and throw:"e⇩2 = THROW ClassCast"
from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs = Xs ∧ s⇩1 = s⇩2" by simp
with wf eval_ref sconf wte have last:"last Cs = D" and notempty:"Cs ≠ []"
by(auto dest!:eval_preserves_type Subobjs_nonempty split:if_split_asm)
from disj have "C = D"
proof(rule disjE)
assume path_unique:"P ⊢ Path D to C unique"
with last have "P ⊢ D ≼⇧* C"
by(fastforce dest:Subobjs_subclass simp:path_unique_def)
with notleq last eq show ?thesis by simp
next
assume ass:"P ⊢ C ≼⇧* D ∧
(∀Cs. P ⊢ Path C to D via Cs ⟶ Subobjs⇩R P C Cs)"
with "class" wf obtain Cs'' where path_via':"P ⊢ Path C to D via Cs''"
by(auto dest:leq_implies_path)
with path_via wf eq last have "Cs'' = [D]"
by(fastforce dest:path_via_reverse)
with ass path_via' have "Subobjs⇩R P C [D]" by simp
thus ?thesis by(fastforce dest:hd_SubobjsR)
qed
with last notin eq notempty show "ref (a,Ds) = e⇩2 ∧ s⇩1 = s⇩2"
by(fastforce intro:last_in_set)
next
fix e' assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩2⟩"
from IH[OF eval_throw wte sconf] show "ref (a,Ds) = e⇩2 ∧ s⇩1 = s⇩2" by simp
qed
next
case (StaticDownCast E e s⇩0 a Cs C Cs' s⇩1 e⇩2 s⇩2 T)
have eval:"P,E ⊢ ⟨⦇C⦈e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩"
and eval':"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a,Cs@[C]@Cs'),s⇩1⟩"
and wt:"P,E ⊢ ⦇C⦈e :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH:"⋀e⇩2 s⇩2 T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ ref(a,Cs@[C]@Cs') = e⇩2 ∧ s⇩1 = s⇩2" by fact+
from wt obtain D where wte:"P,E ⊢ e :: Class D"
and disj:"P ⊢ Path D to C unique ∨
(P ⊢ C ≼⇧* D ∧ (∀Cs. P ⊢ Path C to D via Cs ⟶ Subobjs⇩R P C Cs))"
by auto
from eval show ?case
proof(rule eval_cases)
fix Xs Xs' a'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs),s⇩2⟩"
and path_via:"P ⊢ Path last Xs to C via Xs'"
and ref:"e⇩2 = ref (a',Xs@⇩pXs')"
from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs@[C]@Cs' = Xs ∧ s⇩1 = s⇩2"
by simp
with wf eval_ref sconf wte obtain C' where
last:"last(C#Cs') = D" and "Subobjs P C' (Cs@[C]@Cs')"
by(auto dest:eval_preserves_type split:if_split_asm)
hence "P ⊢ Path C to D via C#Cs'"
by(fastforce intro:Subobjs_Subobjs simp:path_via_def)
with eq last path_via wf have "Xs' = [C] ∧ Cs' = [] ∧ C = D"
apply clarsimp
apply(split if_split_asm)
by(simp,drule path_via_reverse,simp,simp)+
with ref eq show "ref(a,Cs@[C]) = e⇩2 ∧ s⇩1 = s⇩2" by(fastforce simp:appendPath_def)
next
fix Xs Xs' a'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs@C#Xs'),s⇩2⟩"
and ref:"e⇩2 = ref (a',Xs@[C])"
from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs@[C]@Cs' = Xs@C#Xs' ∧ s⇩1 = s⇩2"
by simp
with wf eval_ref sconf wte obtain C' where
last:"last(C#Xs') = D" and subo:"Subobjs P C' (Cs@[C]@Cs')"
by(auto dest:eval_preserves_type split:if_split_asm)
from subo wf have notin:"C ∉ set Cs" by -(rule unique2,simp)
from subo wf have "C ∉ set Cs'" by -(rule unique1,simp,simp)
with notin eq have "Cs = Xs ∧ Cs' = Xs'"
by -(rule only_one_append,simp+)
with eq ref show "ref(a,Cs@[C]) = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
assume eval_null:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⇩2⟩"
from IH[OF eval_null wte sconf] show "ref (a,Cs@[C]) = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix Xs a'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs),s⇩2⟩" and notin:"C ∉ set Xs"
from IH[OF eval_ref wte sconf] have "a = a' ∧ Cs@[C]@Cs' = Xs ∧ s⇩1 = s⇩2"
by simp
with notin show "ref(a,Cs@[C]) = e⇩2 ∧ s⇩1 = s⇩2" by fastforce
next
fix e' assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩2⟩"
from IH[OF eval_throw wte sconf] show "ref (a,Cs@[C]) = e⇩2 ∧ s⇩1 = s⇩2" by simp
qed
next
case (StaticCastNull E e s⇩0 s⇩1 C e⇩2 s⇩2 T)
have eval:"P,E ⊢ ⟨⦇C⦈e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩"
and wt:"P,E ⊢ ⦇C⦈e :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH:"⋀e⇩2 s⇩2 T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ null = e⇩2 ∧ s⇩1 = s⇩2" by fact+
from wt obtain D where wte:"P,E ⊢ e :: Class D" by auto
from eval show ?case
proof(rule eval_cases)
fix Xs Xs' a'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref (a',Xs),s⇩2⟩"
from IH[OF eval_ref wte sconf] show "null = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix Xs Xs' a'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs@C#Xs'),s⇩2⟩"
from IH[OF eval_ref wte sconf] show "null = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
assume eval_null:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⇩2⟩" and "e⇩2 = null"
with IH[OF eval_null wte sconf] show "null = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix Xs a'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs),s⇩2⟩"
from IH[OF eval_ref wte sconf] show "null = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix e' assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩2⟩"
from IH[OF eval_throw wte sconf] show "null = e⇩2 ∧ s⇩1 = s⇩2" by simp
qed
next
case (StaticCastFail E e s⇩0 a Cs s⇩1 C e⇩2 s⇩2 T)
have eval:"P,E ⊢ ⟨⦇C⦈e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩"
and notleq:"¬ P ⊢ last Cs ≼⇧* C" and notin:"C ∉ set Cs"
and wt:"P,E ⊢ ⦇C⦈e :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH:"⋀e⇩2 s⇩2 T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ref (a, Cs) = e⇩2 ∧ s⇩1 = s⇩2" by fact+
from wt obtain D where wte:"P,E ⊢ e :: Class D" by auto
from eval show ?case
proof(rule eval_cases)
fix Xs Xs' a'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref (a',Xs),s⇩2⟩"
and path_via:"P ⊢ Path last Xs to C via Xs'"
from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs = Xs ∧ s⇩1 = s⇩2" by simp
with path_via wf have "P ⊢ last Cs ≼⇧* C"
by(auto dest:Subobjs_subclass simp:path_via_def)
with notleq show "THROW ClassCast = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix Xs Xs' a'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs@C#Xs'),s⇩2⟩"
from IH[OF eval_ref wte sconf] have "a = a' ∧ Cs = Xs@C#Xs' ∧ s⇩1 = s⇩2" by simp
with notin show "THROW ClassCast = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
assume eval_null:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⇩2⟩"
from IH[OF eval_null wte sconf] show "THROW ClassCast = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix Xs a'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs),s⇩2⟩"
and throw:"e⇩2 = THROW ClassCast"
from IH[OF eval_ref wte sconf] have "a = a' ∧ Cs = Xs ∧ s⇩1 = s⇩2"
by simp
with throw show "THROW ClassCast = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix e' assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩2⟩"
from IH[OF eval_throw wte sconf] show "THROW ClassCast = e⇩2 ∧ s⇩1 = s⇩2" by simp
qed
next
case (StaticCastThrow E e s⇩0 e' s⇩1 C e⇩2 s⇩2 T)
have eval:"P,E ⊢ ⟨⦇C⦈e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩"
and wt:"P,E ⊢ ⦇C⦈e :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH:"⋀e⇩2 s⇩2 T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ throw e' = e⇩2 ∧ s⇩1 = s⇩2" by fact+
from wt obtain D where wte:"P,E ⊢ e :: Class D" by auto
from eval show ?case
proof(rule eval_cases)
fix Xs Xs' a'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref (a',Xs),s⇩2⟩"
from IH[OF eval_ref wte sconf] show " throw e' = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix Xs Xs' a'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs@C#Xs'),s⇩2⟩"
from IH[OF eval_ref wte sconf] show "throw e' = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
assume eval_null:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⇩2⟩"
from IH[OF eval_null wte sconf] show "throw e' = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix Xs a'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs),s⇩2⟩"
from IH[OF eval_ref wte sconf] show "throw e' = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix e'' assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw e'',s⇩2⟩"
and throw:"e⇩2 = throw e''"
from IH[OF eval_throw wte sconf] throw show "throw e' = e⇩2 ∧ s⇩1 = s⇩2" by simp
qed
next
case (StaticUpDynCast E e s⇩0 a Cs s⇩1 C Cs' Ds e⇩2 s⇩2 T)
have eval:"P,E ⊢ ⟨Cast C e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩"
and path_via:"P ⊢ Path last Cs to C via Cs'"
and path_unique:"P ⊢ Path last Cs to C unique"
and Ds:"Ds = Cs@⇩pCs'" and wt:"P,E ⊢ Cast C e :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH:"⋀e⇩2 s⇩2 T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ ref(a,Cs) = e⇩2 ∧ s⇩1 = s⇩2" by fact+
from wt obtain D where wte:"P,E ⊢ e :: Class D" by auto
from eval show ?case
proof(rule eval_cases)
fix Xs Xs' a'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref (a',Xs),s⇩2⟩"
and path_via':"P ⊢ Path last Xs to C via Xs'"
and ref:"e⇩2 = ref (a',Xs@⇩pXs')"
from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs = Xs ∧ s⇩1 = s⇩2" by simp
with wf eval_ref sconf wte have last:"last Cs = D"
by(auto dest:eval_preserves_type split:if_split_asm)
with path_unique path_via path_via' eq have "Xs' = Cs'"
by(fastforce simp:path_via_def path_unique_def)
with eq Ds ref show "ref (a, Ds) = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix Xs Xs' a'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs@C#Xs'),s⇩2⟩"
and ref:"e⇩2 = ref (a',Xs@[C])"
from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs = Xs@C#Xs' ∧ s⇩1 = s⇩2" by simp
with wf eval_ref sconf wte obtain C' where
last:"last Cs = D" and "Subobjs P C' (Xs@C#Xs')"
by(auto dest:eval_preserves_type split:if_split_asm)
hence "Subobjs P C (C#Xs')" by(fastforce intro:Subobjs_Subobjs)
with last eq have "P ⊢ Path C to D via C#Xs'"
by(simp add:path_via_def)
with path_via wf last have "Xs' = [] ∧ Cs' = [C] ∧ C = D"
by(fastforce dest:path_via_reverse)
with eq Ds ref show "ref (a, Ds) = e⇩2 ∧ s⇩1 = s⇩2" by (simp add:appendPath_def)
next
fix Xs Xs' D' S a' h l
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs),(h,l)⟩"
and h:"h a' = Some(D',S)" and path_via':"P ⊢ Path D' to C via Xs'"
and path_unique':"P ⊢ Path D' to C unique" and s2:"s⇩2 = (h,l)"
and ref:"e⇩2 = ref(a',Xs')"
from IH[OF eval_ref wte sconf] s2 have eq:"a = a' ∧ Cs = Xs ∧ s⇩1 = s⇩2" by simp
with wf eval_ref sconf wte h have "last Cs = D"
and "Subobjs P D' Cs"
by(auto dest:eval_preserves_type split:if_split_asm)
with path_via wf have "P ⊢ Path D' to C via Cs@⇩pCs'"
by(fastforce intro:Subobjs_appendPath appendPath_last[THEN sym]
dest:Subobjs_nonempty simp:path_via_def)
with path_via' path_unique' Ds have "Xs' = Ds"
by(fastforce simp:path_via_def path_unique_def)
with eq ref show "ref (a, Ds) = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
assume eval_null:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⇩2⟩"
from IH[OF eval_null wte sconf] show "ref (a, Ds) = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix Xs D' S a' h l
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs),(h,l)⟩"
and not_unique:"¬ P ⊢ Path last Xs to C unique" and s2:"s⇩2 = (h,l)"
from IH[OF eval_ref wte sconf] s2 have eq:"a = a' ∧ Cs = Xs ∧ s⇩1 = s⇩2" by simp
with path_unique not_unique show "ref (a, Ds) = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix e' assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩2⟩"
from IH[OF eval_throw wte sconf] show "ref (a, Ds) = e⇩2 ∧ s⇩1 = s⇩2" by simp
qed
next
case (StaticDownDynCast E e s⇩0 a Cs C Cs' s⇩1 e⇩2 s⇩2 T)
have eval:"P,E ⊢ ⟨Cast C e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩"
and wt:"P,E ⊢ Cast C e :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH:"⋀e⇩2 s⇩2 T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ ref(a,Cs@[C]@Cs') = e⇩2 ∧ s⇩1 = s⇩2" by fact+
from wt obtain D where wte:"P,E ⊢ e :: Class D" by auto
from eval show ?case
proof(rule eval_cases)
fix Xs Xs' a'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs),s⇩2⟩"
and path_via:"P ⊢ Path last Xs to C via Xs'"
and ref:"e⇩2 = ref (a',Xs@⇩pXs')"
from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs@[C]@Cs' = Xs ∧ s⇩1 = s⇩2"
by simp
with wf eval_ref sconf wte obtain C' where
last:"last(C#Cs') = D" and "Subobjs P C' (Cs@[C]@Cs')"
by(auto dest:eval_preserves_type split:if_split_asm)
hence "P ⊢ Path C to D via C#Cs'"
by(fastforce intro:Subobjs_Subobjs simp:path_via_def)
with eq last path_via wf have "Xs' = [C] ∧ Cs' = [] ∧ C = D"
apply clarsimp
apply(split if_split_asm)
by(simp,drule path_via_reverse,simp,simp)+
with ref eq show "ref(a,Cs@[C]) = e⇩2 ∧ s⇩1 = s⇩2" by(fastforce simp:appendPath_def)
next
fix Xs Xs' a'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs@C#Xs'),s⇩2⟩"
and ref:"e⇩2 = ref (a',Xs@[C])"
from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs@[C]@Cs' = Xs@C#Xs' ∧ s⇩1 = s⇩2"
by simp
with wf eval_ref sconf wte obtain C' where
last:"last(C#Xs') = D" and subo:"Subobjs P C' (Cs@[C]@Cs')"
by(auto dest:eval_preserves_type split:if_split_asm)
from subo wf have notin:"C ∉ set Cs" by -(rule unique2,simp)
from subo wf have "C ∉ set Cs'" by -(rule unique1,simp,simp)
with notin eq have "Cs = Xs ∧ Cs' = Xs'"
by -(rule only_one_append,simp+)
with eq ref show "ref(a,Cs@[C]) = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix Xs Xs' D' S a' h l
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs),(h,l)⟩"
and h:"h a' = Some(D',S)" and path_via:"P ⊢ Path D' to C via Xs'"
and path_unique:"P ⊢ Path D' to C unique" and s2:"s⇩2 = (h,l)"
and ref:"e⇩2 = ref(a',Xs')"
from IH[OF eval_ref wte sconf] s2 have eq:"a = a' ∧ Cs@[C]@Cs' = Xs ∧ s⇩1 = s⇩2"
by simp
with wf eval_ref sconf wte h have "Subobjs P D' (Cs@[C]@Cs')"
by(auto dest:eval_preserves_type split:if_split_asm)
hence "Subobjs P D' (Cs@[C])" by(fastforce intro:appendSubobj)
with path_via path_unique have "Xs' = Cs@[C]"
by(fastforce simp:path_via_def path_unique_def)
with eq ref show "ref(a,Cs@[C]) = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
assume eval_null:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⇩2⟩"
from IH[OF eval_null wte sconf] show "ref (a,Cs@[C]) = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix Xs D' S a' h l
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs),(h,l)⟩"
and notin:"C ∉ set Xs" and s2:"s⇩2 = (h,l)"
from IH[OF eval_ref wte sconf] s2 have "a = a' ∧ Cs@[C]@Cs' = Xs ∧ s⇩1 = s⇩2"
by simp
with notin show "ref (a,Cs@[C]) = e⇩2 ∧ s⇩1 = s⇩2" by fastforce
next
fix e' assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩2⟩"
from IH[OF eval_throw wte sconf] show "ref (a,Cs@[C]) = e⇩2 ∧ s⇩1 = s⇩2" by simp
qed
next
case (DynCast E e s⇩0 a Cs h l D S C Cs' e⇩2 s⇩2 T)
have eval:"P,E ⊢ ⟨Cast C e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩"
and path_via:"P ⊢ Path D to C via Cs'" and path_unique:"P ⊢ Path D to C unique"
and h:"h a = Some(D,S)" and wt:"P,E ⊢ Cast C e :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH:"⋀e⇩2 s⇩2 T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ ref(a,Cs) = e⇩2 ∧ (h,l) = s⇩2" by fact+
from wt obtain D' where wte:"P,E ⊢ e :: Class D'" by auto
from eval show ?case
proof(rule eval_cases)
fix Xs Xs' a'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs),s⇩2⟩"
and path_via':"P ⊢ Path last Xs to C via Xs'"
and ref:"e⇩2 = ref (a',Xs@⇩pXs')"
from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs = Xs ∧ (h,l) = s⇩2" by simp
with wf eval_ref sconf wte h have "last Cs = D'"
and "Subobjs P D Cs"
by(auto dest:eval_preserves_type split:if_split_asm)
with path_via' wf eq have "P ⊢ Path D to C via Xs@⇩pXs'"
by(fastforce intro:Subobjs_appendPath appendPath_last[THEN sym]
dest:Subobjs_nonempty simp:path_via_def)
with path_via path_unique have "Cs' = Xs@⇩pXs'"
by(fastforce simp:path_via_def path_unique_def)
with ref eq show "ref(a,Cs') = e⇩2 ∧ (h, l) = s⇩2" by simp
next
fix Xs Xs' a'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs@C#Xs'),s⇩2⟩"
and ref:"e⇩2 = ref (a',Xs@[C])"
from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs = Xs@C#Xs' ∧ (h,l) = s⇩2"
by simp
with wf eval_ref sconf wte h have "Subobjs P D (Xs@[C]@Xs')"
by(auto dest:eval_preserves_type split:if_split_asm)
hence "Subobjs P D (Xs@[C])" by(fastforce intro:appendSubobj)
with path_via path_unique have "Cs' = Xs@[C]"
by(fastforce simp:path_via_def path_unique_def)
with eq ref show "ref(a,Cs') = e⇩2 ∧ (h, l) = s⇩2" by simp
next
fix Xs Xs' D'' S' a' h' l'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs),(h',l')⟩"
and h':"h' a' = Some(D'',S')" and path_via':"P ⊢ Path D'' to C via Xs'"
and s2:"s⇩2 = (h',l')" and ref:"e⇩2 = ref(a',Xs')"
from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs = Xs ∧ h = h' ∧ l = l'"
by simp
with h h' path_via path_via' path_unique s2 ref
show "ref(a,Cs') = e⇩2 ∧ (h,l) = s⇩2"
by(fastforce simp:path_via_def path_unique_def)
next
assume eval_null:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⇩2⟩"
from IH[OF eval_null wte sconf] show "ref(a,Cs') = e⇩2 ∧ (h,l) = s⇩2" by simp
next
fix Xs D'' S' a' h' l'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs),(h',l')⟩"
and h':"h' a' = Some(D'',S')" and not_unique:"¬ P ⊢ Path D'' to C unique"
from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs = Xs ∧ h = h' ∧ l = l'"
by simp
with h h' path_unique not_unique show "ref(a,Cs') = e⇩2 ∧ (h,l) = s⇩2" by simp
next
fix e' assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩2⟩"
from IH[OF eval_throw wte sconf] show "ref (a,Cs') = e⇩2 ∧ (h,l) = s⇩2" by simp
qed
next
case (DynCastNull E e s⇩0 s⇩1 C e⇩2 s⇩2 T)
have eval:"P,E ⊢ ⟨Cast C e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩"
and wt:"P,E ⊢ Cast C e :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH:"⋀e⇩2 s⇩2 T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ null = e⇩2 ∧ s⇩1 = s⇩2" by fact+
from wt obtain D where wte:"P,E ⊢ e :: Class D" by auto
from eval show ?case
proof(rule eval_cases)
fix Xs Xs' a'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref (a',Xs),s⇩2⟩"
from IH[OF eval_ref wte sconf] show "null = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix Xs Xs' a'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs@C#Xs'),s⇩2⟩"
from IH[OF eval_ref wte sconf] show "null = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix Xs Xs' D' S a' h l
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs),(h,l)⟩"
from IH[OF eval_ref wte sconf] show "null = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
assume eval_null:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⇩2⟩" and "e⇩2 = null"
with IH[OF eval_null wte sconf] show "null = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix Xs D' S a' h l
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs),(h,l)⟩" and s2:"s⇩2 = (h,l)"
from IH[OF eval_ref wte sconf] s2 show "null = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix e' assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩2⟩"
from IH[OF eval_throw wte sconf] show "null = e⇩2 ∧ s⇩1 = s⇩2" by simp
qed
next
case (DynCastFail E e s⇩0 a Cs h l D S C e⇩2 s⇩2 T)
have eval:"P,E ⊢ ⟨Cast C e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩"
and h:"h a = Some(D,S)" and not_unique1:"¬ P ⊢ Path D to C unique"
and not_unique2:"¬ P ⊢ Path last Cs to C unique" and notin:"C ∉ set Cs"
and wt:"P,E ⊢ Cast C e :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH:"⋀e⇩2 s⇩2 T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ ref (a, Cs) = e⇩2 ∧ (h,l) = s⇩2" by fact+
from wt obtain D' where wte:"P,E ⊢ e :: Class D'" by auto
from eval show ?case
proof(rule eval_cases)
fix Xs Xs' a'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs),s⇩2⟩"
and path_unique:"P ⊢ Path last Xs to C unique"
from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs = Xs ∧ (h,l) = s⇩2" by simp
with path_unique not_unique2 show "null = e⇩2 ∧ (h,l) = s⇩2" by simp
next
fix Xs Xs' a'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs@C#Xs'),s⇩2⟩"
from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs = Xs@C#Xs' ∧ (h,l) = s⇩2"
by simp
with notin show "null = e⇩2 ∧ (h,l) = s⇩2" by fastforce
next
fix Xs Xs' D'' S' a' h' l'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs),(h',l')⟩"
and h':"h' a' = Some(D'',S')" and path_unique:"P ⊢ Path D'' to C unique"
from IH[OF eval_ref wte sconf] have "a = a' ∧ Cs = Xs ∧ h = h' ∧ l = l'"
by simp
with h h' not_unique1 path_unique show "null = e⇩2 ∧ (h,l) = s⇩2" by simp
next
assume eval_null:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⇩2⟩"
from IH[OF eval_null wte sconf] show "null = e⇩2 ∧ (h,l) = s⇩2" by simp
next
fix Xs D'' S' a' h' l'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs),(h',l')⟩"
and null:"e⇩2 = null" and s2:"s⇩2 = (h',l')"
from IH[OF eval_ref wte sconf] null s2 show "null = e⇩2 ∧ (h,l) = s⇩2" by simp
next
fix e' assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩2⟩"
from IH[OF eval_throw wte sconf] show "null = e⇩2 ∧ (h,l) = s⇩2" by simp
qed
next
case (DynCastThrow E e s⇩0 e' s⇩1 C e⇩2 s⇩2 T)
have eval:"P,E ⊢ ⟨Cast C e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩"
and wt:"P,E ⊢ Cast C e :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH:"⋀e⇩2 s⇩2 T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ throw e' = e⇩2 ∧ s⇩1 = s⇩2" by fact+
from wt obtain D where wte:"P,E ⊢ e :: Class D" by auto
from eval show ?case
proof(rule eval_cases)
fix Xs Xs' a'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref (a',Xs),s⇩2⟩"
from IH[OF eval_ref wte sconf] show " throw e' = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix Xs Xs' a'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs@C#Xs'),s⇩2⟩"
from IH[OF eval_ref wte sconf] show "throw e' = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix Xs Xs' D'' S' a' h' l'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs),(h',l')⟩"
from IH[OF eval_ref wte sconf] show "throw e' = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
assume eval_null:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⇩2⟩"
from IH[OF eval_null wte sconf] show "throw e' = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix Xs D'' S' a' h' l'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs),(h',l')⟩"
from IH[OF eval_ref wte sconf] show "throw e' = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix e'' assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw e'',s⇩2⟩"
and throw:"e⇩2 = throw e''"
from IH[OF eval_throw wte sconf] throw show "throw e' = e⇩2 ∧ s⇩1 = s⇩2" by simp
qed
next
case Val thus ?case by(auto elim: eval_cases)
next
case (BinOp E e⇩1 s⇩0 v⇩1 s⇩1 e⇩2 v⇩2 s⇩2 bop v e⇩2' s⇩2' T)
have eval:"P,E ⊢ ⟨e⇩1 «bop» e⇩2,s⇩0⟩ ⇒ ⟨e⇩2',s⇩2'⟩"
and binop:"binop (bop, v⇩1, v⇩2) = Some v"
and wt:"P,E ⊢ e⇩1 «bop» e⇩2 :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH1:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩1 :: T; P,E ⊢ s⇩0 √⟧
⟹ Val v⇩1 = ei ∧ s⇩1 = si"
and IH2:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩2,s⇩1⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩2 :: T; P,E ⊢ s⇩1 √⟧
⟹ Val v⇩2 = ei ∧ s⇩2 = si" by fact+
from wt obtain T⇩1 T⇩2 where wte1:"P,E ⊢ e⇩1 :: T⇩1" and wte2:"P,E ⊢ e⇩2 :: T⇩2"
by auto
from eval show ?case
proof(rule eval_cases)
fix s w w⇩1 w⇩2
assume eval_val1:"P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨Val w⇩1,s⟩"
and eval_val2:"P,E ⊢ ⟨e⇩2,s⟩ ⇒ ⟨Val w⇩2,s⇩2'⟩"
and binop':"binop(bop,w⇩1,w⇩2) = Some w" and e2':"e⇩2' = Val w"
from IH1[OF eval_val1 wte1 sconf] have w1:"v⇩1 = w⇩1" and s:"s = s⇩1" by simp_all
with wf eval_val1 wte1 sconf have "P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF eval_val2[simplified s] wte2 this] have "v⇩2 = w⇩2" and s2:"s⇩2 = s⇩2'"
by simp_all
with w1 binop binop' have "w = v" by simp
with e2' s2 show "Val v = e⇩2' ∧ s⇩2 = s⇩2'" by simp
next
fix e assume eval_throw:"P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨throw e,s⇩2'⟩"
from IH1[OF eval_throw wte1 sconf] show "Val v = e⇩2' ∧ s⇩2 = s⇩2'" by simp
next
fix e s w
assume eval_val:"P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨Val w,s⟩"
and eval_throw:"P,E ⊢ ⟨e⇩2,s⟩ ⇒ ⟨throw e,s⇩2'⟩"
from IH1[OF eval_val wte1 sconf] have s:"s = s⇩1" by simp_all
with wf eval_val wte1 sconf have "P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF eval_throw[simplified s] wte2 this] show "Val v = e⇩2' ∧ s⇩2 = s⇩2'"
by simp
qed
next
case (BinOpThrow1 E e⇩1 s⇩0 e s⇩1 bop e⇩2 e⇩2' s⇩2 T)
have eval:"P,E ⊢ ⟨e⇩1 «bop» e⇩2,s⇩0⟩ ⇒ ⟨e⇩2',s⇩2⟩"
and wt:"P,E ⊢ e⇩1 «bop» e⇩2 :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩1 :: T; P,E ⊢ s⇩0 √⟧
⟹ throw e = ei ∧ s⇩1 = si" by fact+
from wt obtain T⇩1 T⇩2 where wte1:"P,E ⊢ e⇩1 :: T⇩1" by auto
from eval show ?case
proof(rule eval_cases)
fix s w w⇩1 w⇩2
assume eval_val:"P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨Val w⇩1,s⟩"
from IH[OF eval_val wte1 sconf] show "throw e = e⇩2' ∧ s⇩1 = s⇩2" by simp
next
fix e'
assume eval_throw:"P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨throw e',s⇩2⟩" and throw:"e⇩2' = throw e'"
from IH[OF eval_throw wte1 sconf] throw show "throw e = e⇩2' ∧ s⇩1 = s⇩2" by simp
next
fix e s w
assume eval_val:"P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨Val w,s⟩"
from IH[OF eval_val wte1 sconf] show "throw e = e⇩2' ∧ s⇩1 = s⇩2" by simp
qed
next
case (BinOpThrow2 E e⇩1 s⇩0 v⇩1 s⇩1 e⇩2 e s⇩2 bop e⇩2' s⇩2' T)
have eval:"P,E ⊢ ⟨e⇩1 «bop» e⇩2,s⇩0⟩ ⇒ ⟨e⇩2',s⇩2'⟩"
and wt:"P,E ⊢ e⇩1 «bop» e⇩2 :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH1:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩1 :: T; P,E ⊢ s⇩0 √⟧
⟹ Val v⇩1 = ei ∧ s⇩1 = si"
and IH2:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩2,s⇩1⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩2 :: T; P,E ⊢ s⇩1 √⟧
⟹ throw e = ei ∧ s⇩2 = si" by fact+
from wt obtain T⇩1 T⇩2 where wte1:"P,E ⊢ e⇩1 :: T⇩1" and wte2:"P,E ⊢ e⇩2 :: T⇩2"
by auto
from eval show ?case
proof(rule eval_cases)
fix s w w⇩1 w⇩2
assume eval_val1:"P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨Val w⇩1,s⟩"
and eval_val2:"P,E ⊢ ⟨e⇩2,s⟩ ⇒ ⟨Val w⇩2,s⇩2'⟩"
from IH1[OF eval_val1 wte1 sconf] have s:"s = s⇩1" by simp_all
with wf eval_val1 wte1 sconf have "P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF eval_val2[simplified s] wte2 this] show "throw e = e⇩2' ∧ s⇩2 = s⇩2'"
by simp
next
fix e'
assume eval_throw:"P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨throw e',s⇩2'⟩"
from IH1[OF eval_throw wte1 sconf] show "throw e = e⇩2' ∧ s⇩2 = s⇩2'" by simp
next
fix e' s w
assume eval_val:"P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨Val w,s⟩"
and eval_throw:"P,E ⊢ ⟨e⇩2,s⟩ ⇒ ⟨throw e',s⇩2'⟩"
and throw:"e⇩2' = throw e'"
from IH1[OF eval_val wte1 sconf] have s:"s = s⇩1" by simp_all
with wf eval_val wte1 sconf have "P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF eval_throw[simplified s] wte2 this] throw
show "throw e = e⇩2' ∧ s⇩2 = s⇩2'"
by simp
qed
next
case Var thus ?case by(auto elim: eval_cases)
next
case (LAss E e s⇩0 v h l V T v' l' e⇩2 s⇩2 T')
have eval:"P,E ⊢ ⟨V:=e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩"
and env:"E V = Some T" and casts:"P ⊢ T casts v to v'" and l':"l' = l(V ↦ v')"
and wt:"P,E ⊢ V:=e :: T'" and sconf:"P,E ⊢ s⇩0 √"
and IH:"⋀e⇩2 s⇩2 T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ Val v = e⇩2 ∧ (h,l) = s⇩2" by fact+
from wt env obtain T'' where wte:"P,E ⊢ e :: T''" and leq:"P ⊢ T'' ≤ T" by auto
from eval show ?case
proof(rule eval_cases)
fix U h' l'' w w'
assume eval_val:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨Val w,(h',l'')⟩" and env':"E V = Some U"
and casts':"P ⊢ U casts w to w'" and e2:"e⇩2 = Val w'"
and s2:"s⇩2 = (h',l''(V ↦ w'))"
from env env' have UeqT:"U = T" by simp
from IH[OF eval_val wte sconf] have eq:"v = w ∧ h = h' ∧ l = l''" by simp
from sconf env have "is_type P T"
by(clarsimp simp:sconf_def envconf_def)
with casts casts' eq UeqT wte leq eval_val sconf wf have "v' = w'"
by(auto intro:casts_casts_eq_result)
with e2 s2 l' eq show "Val v' = e⇩2 ∧ (h, l') = s⇩2" by simp
next
fix e' assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩2⟩"
from IH[OF eval_throw wte sconf] show "Val v' = e⇩2 ∧ (h, l') = s⇩2" by simp
qed
next
case (LAssThrow E e s⇩0 e' s⇩1 V e⇩2 s⇩2 T)
have eval:"P,E ⊢ ⟨V:=e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩"
and wt:"P,E ⊢ V:=e :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH:"⋀e⇩2 s⇩2 T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ throw e' = e⇩2 ∧ s⇩1 = s⇩2" by fact+
from wt obtain T'' where wte:"P,E ⊢ e :: T''" by auto
from eval show ?case
proof(rule eval_cases)
fix U h' l'' w w'
assume eval_val:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨Val w,(h',l'')⟩"
from IH[OF eval_val wte sconf] show "throw e' = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix ex
assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw ex,s⇩2⟩" and e2:"e⇩2 = throw ex"
from IH[OF eval_throw wte sconf] e2 show "throw e' = e⇩2 ∧ s⇩1 = s⇩2" by simp
qed
next
case (FAcc E e s⇩0 a Cs' h l D S Ds Cs fs F v e⇩2 s⇩2 T)
have eval:"P,E ⊢ ⟨e∙F{Cs},s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩"
and eval':"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref (a, Cs'),(h,l)⟩"
and h:"h a = Some(D,S)" and Ds:"Ds = Cs'@⇩pCs"
and S:"(Ds,fs) ∈ S" and fs:"fs F = Some v"
and wt:"P,E ⊢ e∙F{Cs} :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH:"⋀e⇩2 s⇩2 T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ ref (a, Cs') = e⇩2 ∧ (h,l) = s⇩2" by fact+
from wt obtain C where wte:"P,E ⊢ e :: Class C" by auto
from eval_preserves_sconf[OF wf eval' wte sconf] h have oconf:"P,h ⊢ (D,S) √"
by(simp add:sconf_def hconf_def)
from eval show ?case
proof(rule eval_cases)
fix Xs' D' S' a' fs' h' l' v'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs'),(h',l')⟩"
and h':"h' a' = Some(D',S')" and S':"(Xs'@⇩pCs,fs') ∈ S'"
and fs':"fs' F = Some v'" and e2:"e⇩2 = Val v'" and s2:"s⇩2 = (h',l')"
from IH[OF eval_ref wte sconf] h h'
have eq:"a = a' ∧ Cs' = Xs' ∧ h = h' ∧ l = l' ∧ D = D' ∧ S = S'" by simp
with oconf S S' Ds have "fs = fs'" by (auto simp:oconf_def)
with fs fs' have "v = v'" by simp
with e2 s2 eq show "Val v = e⇩2 ∧ (h,l) = s⇩2" by simp
next
assume eval_null:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⇩2⟩"
from IH[OF eval_null wte sconf] show "Val v = e⇩2 ∧ (h,l) = s⇩2" by simp
next
fix e' assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩2⟩"
from IH[OF eval_throw wte sconf] show "Val v = e⇩2 ∧ (h,l) = s⇩2" by simp
qed
next
case (FAccNull E e s⇩0 s⇩1 F Cs e⇩2 s⇩2 T)
have eval:"P,E ⊢ ⟨e∙F{Cs},s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩"
and wt:"P,E ⊢ e∙F{Cs} :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH:"⋀e⇩2 s⇩2 T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ null = e⇩2 ∧ s⇩1 = s⇩2" by fact+
from wt obtain C where wte:"P,E ⊢ e :: Class C" by auto
from eval show ?case
proof(rule eval_cases)
fix Xs' D' S' a' fs' h' l' v'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs'),(h',l')⟩"
from IH[OF eval_ref wte sconf] show "THROW NullPointer = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
assume eval_null:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⇩2⟩" and e2:"e⇩2 = THROW NullPointer"
from IH[OF eval_null wte sconf] e2 show "THROW NullPointer = e⇩2 ∧ s⇩1 = s⇩2"
by simp
next
fix e' assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩2⟩"
from IH[OF eval_throw wte sconf] show "THROW NullPointer = e⇩2 ∧ s⇩1 = s⇩2" by simp
qed
next
case (FAccThrow E e s⇩0 e' s⇩1 F Cs e⇩2 s⇩2 T)
have eval:"P,E ⊢ ⟨e∙F{Cs},s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩"
and wt:"P,E ⊢ e∙F{Cs} :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH:"⋀e⇩2 s⇩2 T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ throw e' = e⇩2 ∧ s⇩1 = s⇩2" by fact+
from wt obtain C where wte:"P,E ⊢ e :: Class C" by auto
from eval show ?case
proof(rule eval_cases)
fix Xs' D' S' a' fs' h' l' v'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs'),(h',l')⟩"
from IH[OF eval_ref wte sconf] show "throw e' = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
assume eval_null:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⇩2⟩"
from IH[OF eval_null wte sconf] show "throw e' = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix ex
assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw ex,s⇩2⟩" and e2:"e⇩2 = throw ex"
from IH[OF eval_throw wte sconf] e2 show "throw e' = e⇩2 ∧ s⇩1 = s⇩2" by simp
qed
next
case (FAss E e⇩1 s⇩0 a Cs' s⇩1 e⇩2 v h⇩2 l⇩2 D S F T Cs v' Ds fs fs' S' h⇩2' e⇩2' s⇩2 T')
have eval:"P,E ⊢ ⟨e⇩1∙F{Cs} := e⇩2,s⇩0⟩ ⇒ ⟨e⇩2',s⇩2⟩"
and eval':"P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨ref(a,Cs'),s⇩1⟩"
and eval'':"P,E ⊢ ⟨e⇩2,s⇩1⟩ ⇒ ⟨Val v,(h⇩2,l⇩2)⟩"
and h2:"h⇩2 a = Some(D, S)"
and has_least:"P ⊢ last Cs' has least F:T via Cs"
and casts:"P ⊢ T casts v to v'" and Ds:"Ds = Cs'@⇩pCs"
and S:"(Ds, fs) ∈ S" and fs':"fs' = fs(F ↦ v')"
and S':"S' = S - {(Ds, fs)} ∪ {(Ds, fs')}"
and h2':"h⇩2' = h⇩2(a ↦ (D, S'))"
and wt:"P,E ⊢ e⇩1∙F{Cs} := e⇩2 :: T'" and sconf:"P,E ⊢ s⇩0 √"
and IH1:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩1 :: T; P,E ⊢ s⇩0 √⟧
⟹ ref(a,Cs') = ei ∧ s⇩1 = si"
and IH2:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩2,s⇩1⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩2 :: T; P,E ⊢ s⇩1 √⟧
⟹ Val v = ei ∧ (h⇩2,l⇩2) = si" by fact+
from wt obtain C T'' where wte1:"P,E ⊢ e⇩1 :: Class C"
and has_least':"P ⊢ C has least F:T' via Cs"
and wte2:"P,E ⊢ e⇩2 :: T''" and leq:"P ⊢ T'' ≤ T'"
by auto
from wf eval' wte1 sconf have "last Cs' = C"
by(auto dest!:eval_preserves_type split:if_split_asm)
with has_least has_least' have TeqT':"T = T'" by (fastforce intro:sees_field_fun)
from eval show ?case
proof(rule eval_cases)
fix Xs D' S'' U a' fs'' h l s w w'
assume eval_ref:"P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨ref(a',Xs),s⟩"
and eval_val:"P,E ⊢ ⟨e⇩2,s⟩ ⇒ ⟨Val w,(h,l)⟩"
and h:"h a' = Some(D',S'')"
and has_least'':"P ⊢ last Xs has least F:U via Cs"
and casts':"P ⊢ U casts w to w'"
and S'':"(Xs@⇩pCs,fs'') ∈ S''" and e2':"e⇩2' = Val w'"
and s2:"s⇩2 = (h(a'↦(D',insert (Xs@⇩pCs,fs''(F ↦ w'))
(S''-{(Xs@⇩pCs,fs'')}))),l)"
from IH1[OF eval_ref wte1 sconf] have eq:"a = a' ∧ Cs' = Xs ∧ s⇩1 = s" by simp
with wf eval_ref wte1 sconf have sconf':"P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF _ wte2 this] eval_val eq have eq':"v = w ∧ h = h⇩2 ∧ l = l⇩2" by auto
from has_least'' eq has_least have UeqT:"U = T" by (fastforce intro:sees_field_fun)
from has_least wf have "is_type P T" by(rule least_field_is_type)
with casts casts' eq eq' UeqT TeqT' wte2 leq eval_val sconf' wf have v':"v' = w'"
by(auto intro!:casts_casts_eq_result)
from eval_preserves_sconf[OF wf eval'' wte2 sconf'] h2
have oconf:"P,h⇩2 ⊢ (D,S) √"
by(simp add:sconf_def hconf_def)
from eq eq' h2 h have "S = S''" by simp
with oconf eq S S' S'' Ds have "fs = fs''" by (auto simp:oconf_def)
with h2' h h2 eq eq' s2 S' Ds fs' v' e2' show "Val v' = e⇩2' ∧ (h⇩2',l⇩2) = s⇩2"
by simp
next
fix s w assume eval_null:"P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨null,s⟩"
from IH1[OF eval_null wte1 sconf] show "Val v' = e⇩2' ∧ (h⇩2',l⇩2) = s⇩2" by simp
next
fix ex assume eval_throw:"P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨throw ex,s⇩2⟩"
from IH1[OF eval_throw wte1 sconf] show "Val v' = e⇩2' ∧ (h⇩2',l⇩2) = s⇩2" by simp
next
fix ex s w
assume eval_val:"P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨Val w,s⟩"
and eval_throw:"P,E ⊢ ⟨e⇩2,s⟩ ⇒ ⟨throw ex,s⇩2⟩"
from IH1[OF eval_val wte1 sconf] have eq:"s = s⇩1" by simp
with wf eval_val wte1 sconf have sconf':"P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF eval_throw[simplified eq] wte2 this]
show "Val v' = e⇩2' ∧ (h⇩2',l⇩2) = s⇩2" by simp
qed
next
case (FAssNull E e⇩1 s⇩0 s⇩1 e⇩2 v s⇩2 F Cs e⇩2' s⇩2' T)
have eval:"P,E ⊢ ⟨e⇩1∙F{Cs} := e⇩2,s⇩0⟩ ⇒ ⟨e⇩2',s⇩2'⟩"
and wt:"P,E ⊢ e⇩1∙F{Cs} := e⇩2 :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH1:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩1 :: T; P,E ⊢ s⇩0 √⟧
⟹ null = ei ∧ s⇩1 = si"
and IH2:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩2,s⇩1⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩2 :: T; P,E ⊢ s⇩1 √⟧
⟹ Val v = ei ∧ s⇩2 = si" by fact+
from wt obtain C T'' where wte1:"P,E ⊢ e⇩1 :: Class C"
and wte2:"P,E ⊢ e⇩2 :: T''" by auto
from eval show ?case
proof(rule eval_cases)
fix Xs D' S'' U a' fs'' h l s w w'
assume eval_ref:"P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨ref(a',Xs),s⟩"
from IH1[OF eval_ref wte1 sconf] show "THROW NullPointer = e⇩2' ∧ s⇩2 = s⇩2'"
by simp
next
fix s w
assume eval_null:"P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨null,s⟩"
and eval_val:"P,E ⊢ ⟨e⇩2,s⟩ ⇒ ⟨Val w,s⇩2'⟩"
and e2':"e⇩2' = THROW NullPointer"
from IH1[OF eval_null wte1 sconf] have eq:"s = s⇩1" by simp
with wf eval_null wte1 sconf have sconf':"P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF eval_val[simplified eq] wte2 this] e2'
show "THROW NullPointer = e⇩2' ∧ s⇩2 = s⇩2'" by simp
next
fix ex assume eval_throw:"P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨throw ex,s⇩2'⟩"
from IH1[OF eval_throw wte1 sconf] show "THROW NullPointer = e⇩2' ∧ s⇩2 = s⇩2'"
by simp
next
fix ex s w
assume eval_val:"P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨Val w,s⟩"
and eval_throw:"P,E ⊢ ⟨e⇩2,s⟩ ⇒ ⟨throw ex,s⇩2'⟩"
from IH1[OF eval_val wte1 sconf] have eq:"s = s⇩1" by simp
with wf eval_val wte1 sconf have sconf':"P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF eval_throw[simplified eq] wte2 this]
show "THROW NullPointer = e⇩2' ∧ s⇩2 = s⇩2'" by simp
qed
next
case (FAssThrow1 E e⇩1 s⇩0 e' s⇩1 F Cs e⇩2 e⇩2' s⇩2 T)
have eval:"P,E ⊢ ⟨e⇩1∙F{Cs} := e⇩2,s⇩0⟩ ⇒ ⟨e⇩2',s⇩2⟩"
and wt:"P,E ⊢ e⇩1∙F{Cs} := e⇩2 :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩1 :: T; P,E ⊢ s⇩0 √⟧
⟹ throw e' = ei ∧ s⇩1 = si" by fact+
from wt obtain C T'' where wte1:"P,E ⊢ e⇩1 :: Class C" by auto
from eval show ?case
proof(rule eval_cases)
fix Xs D' S'' U a' fs'' h l s w w'
assume eval_ref:"P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨ref(a',Xs),s⟩"
from IH[OF eval_ref wte1 sconf] show "throw e' = e⇩2' ∧ s⇩1 = s⇩2" by simp
next
fix s w
assume eval_null:"P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨null,s⟩"
from IH[OF eval_null wte1 sconf] show "throw e' = e⇩2' ∧ s⇩1 = s⇩2" by simp
next
fix ex
assume eval_throw:"P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨throw ex,s⇩2⟩" and e2':"e⇩2' = throw ex"
from IH[OF eval_throw wte1 sconf] e2' show "throw e' = e⇩2' ∧ s⇩1 = s⇩2" by simp
next
fix ex s w assume eval_val:"P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨Val w,s⟩"
from IH[OF eval_val wte1 sconf] show "throw e' = e⇩2' ∧ s⇩1 = s⇩2" by simp
qed
next
case (FAssThrow2 E e⇩1 s⇩0 v s⇩1 e⇩2 e' s⇩2 F Cs e⇩2' s⇩2' T)
have eval:"P,E ⊢ ⟨e⇩1∙F{Cs} := e⇩2,s⇩0⟩ ⇒ ⟨e⇩2',s⇩2'⟩"
and wt:"P,E ⊢ e⇩1∙F{Cs} := e⇩2 :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH1:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩1 :: T; P,E ⊢ s⇩0 √⟧
⟹ Val v = ei ∧ s⇩1 = si"
and IH2:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩2,s⇩1⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩2 :: T; P,E ⊢ s⇩1 √⟧
⟹ throw e' = ei ∧ s⇩2 = si" by fact+
from wt obtain C T'' where wte1:"P,E ⊢ e⇩1 :: Class C"
and wte2:"P,E ⊢ e⇩2 :: T''" by auto
from eval show ?case
proof(rule eval_cases)
fix Xs D' S'' U a' fs'' h l s w w'
assume eval_ref:"P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨ref(a',Xs),s⟩"
and eval_val:"P,E ⊢ ⟨e⇩2,s⟩ ⇒ ⟨Val w,(h,l)⟩"
from IH1[OF eval_ref wte1 sconf] have eq:"s = s⇩1" by simp
with wf eval_ref wte1 sconf have sconf':"P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF eval_val[simplified eq] wte2 this] show "throw e' = e⇩2' ∧ s⇩2 = s⇩2'"
by simp
next
fix s w
assume eval_null:"P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨null,s⟩"
and eval_val:"P,E ⊢ ⟨e⇩2,s⟩ ⇒ ⟨Val w,s⇩2'⟩"
from IH1[OF eval_null wte1 sconf] have eq:"s = s⇩1" by simp
with wf eval_null wte1 sconf have sconf':"P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF eval_val[simplified eq] wte2 this] show "throw e' = e⇩2' ∧ s⇩2 = s⇩2'"
by simp
next
fix ex assume eval_throw:"P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨throw ex,s⇩2'⟩"
from IH1[OF eval_throw wte1 sconf] show "throw e' = e⇩2' ∧ s⇩2 = s⇩2'" by simp
next
fix ex s w
assume eval_val:"P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨Val w,s⟩"
and eval_throw:"P,E ⊢ ⟨e⇩2,s⟩ ⇒ ⟨throw ex,s⇩2'⟩" and e2':"e⇩2' = throw ex"
from IH1[OF eval_val wte1 sconf] have eq:"s = s⇩1" by simp
with wf eval_val wte1 sconf have sconf':"P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF eval_throw[simplified eq] wte2 this] e2'
show "throw e' = e⇩2' ∧ s⇩2 = s⇩2'" by simp
qed
next
case (CallObjThrow E e s⇩0 e' s⇩1 Copt M es e⇩2 s⇩2 T)
have eval:"P,E ⊢ ⟨Call e Copt M es,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩"
and wt:"P,E ⊢ Call e Copt M es :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH:"⋀e⇩2 s⇩2 T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ throw e' = e⇩2 ∧ s⇩1 = s⇩2" by fact+
from wt obtain C where wte:"P,E ⊢ e :: Class C" by(cases Copt)auto
show ?case
proof(cases Copt)
assume "Copt = None"
with eval have "P,E ⊢ ⟨e∙M(es),s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩" by simp
thus ?thesis
proof(rule eval_cases)
fix ex
assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw ex,s⇩2⟩" and e2:"e⇩2 = throw ex"
from IH[OF eval_throw wte sconf] e2 show "throw e' = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix es' ex' s w ws assume eval_val:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨Val w,s⟩"
from IH[OF eval_val wte sconf] show "throw e' = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix C' Xs Xs' Ds' S' U U' Us Us' a' body'' body''' h h' l l' pns'' pns'''
s ws ws'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs),s⟩"
from IH[OF eval_ref wte sconf] show "throw e' = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix s ws
assume eval_null:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⟩"
from IH[OF eval_null wte sconf] show "throw e' = e⇩2 ∧ s⇩1 = s⇩2" by simp
qed
next
fix C' assume "Copt = Some C'"
with eval have "P,E ⊢ ⟨e∙(C'::)M(es),s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩" by simp
thus ?thesis
proof(rule eval_cases)
fix ex
assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw ex,s⇩2⟩" and e2:"e⇩2 = throw ex"
from IH[OF eval_throw wte sconf] e2 show "throw e' = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix es' ex' s w ws assume eval_val:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨Val w,s⟩"
from IH[OF eval_val wte sconf] show "throw e' = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix C'' Xs Xs' Ds' S' U U' Us Us' a' body'' body''' h h' l l' pns'' pns'''
s ws ws'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs),s⟩"
from IH[OF eval_ref wte sconf] show "throw e' = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix s ws
assume eval_null:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⟩"
from IH[OF eval_null wte sconf] show "throw e' = e⇩2 ∧ s⇩1 = s⇩2" by simp
qed
qed
next
case (CallParamsThrow E e s⇩0 v s⇩1 es vs ex es' s⇩2 Copt M e⇩2 s⇩2' T)
have eval:"P,E ⊢ ⟨Call e Copt M es,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2'⟩"
and wt:"P,E ⊢ Call e Copt M es :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH1:"⋀ei si T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ Val v = ei ∧ s⇩1 = si"
and IH2:"⋀esi si Ts. ⟦P,E ⊢ ⟨es,s⇩1⟩ [⇒] ⟨esi,si⟩; P,E ⊢ es [::] Ts; P,E ⊢ s⇩1 √⟧
⟹ map Val vs @ throw ex # es' = esi ∧ s⇩2 = si" by fact+
from wt obtain C Ts where wte:"P,E ⊢ e :: Class C" and wtes:"P,E ⊢ es [::] Ts"
by(cases Copt)auto
show ?case
proof(cases Copt)
assume "Copt = None"
with eval have "P,E ⊢ ⟨e∙M(es),s⇩0⟩ ⇒ ⟨e⇩2,s⇩2'⟩" by simp
thus ?thesis
proof(rule eval_cases)
fix ex' assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw ex',s⇩2'⟩"
from IH1[OF eval_throw wte sconf] show "throw ex = e⇩2 ∧ s⇩2 = s⇩2'" by simp
next
fix es'' ex' s w ws
assume eval_val:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨Val w,s⟩"
and evals_throw:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val ws@throw ex'#es'',s⇩2'⟩"
and e2:"e⇩2 = throw ex'"
from IH1[OF eval_val wte sconf] have eq:"s = s⇩1" by simp
with wf eval_val wte sconf have sconf':"P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF evals_throw[simplified eq] wtes this] e2
have "vs = ws ∧ ex = ex' ∧ es' = es'' ∧ s⇩2 = s⇩2'"
by(fastforce dest:map_Val_throw_eq)
with e2 show "throw ex = e⇩2 ∧ s⇩2 = s⇩2'" by simp
next
fix C' Xs Xs' Ds' S' U U' Us Us' a' body'' body''' h h' l l' pns'' pns'''
s ws ws'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs),s⟩"
and evals_vals:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val ws,(h,l)⟩"
from IH1[OF eval_ref wte sconf] have eq:"s = s⇩1" by simp
with wf eval_ref wte sconf have sconf':"P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF evals_vals[simplified eq] wtes this]
show "throw ex = e⇩2 ∧ s⇩2 = s⇩2'"
by(fastforce dest:sym[THEN map_Val_throw_False])
next
fix s ws
assume eval_null:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⟩"
and evals_vals:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val ws,s⇩2'⟩"
and e2:"e⇩2 = THROW NullPointer"
from IH1[OF eval_null wte sconf] have eq:"s = s⇩1" by simp
with wf eval_null wte sconf have sconf':"P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF evals_vals[simplified eq] wtes this]
show "throw ex = e⇩2 ∧ s⇩2 = s⇩2'"
by(fastforce dest:sym[THEN map_Val_throw_False])
qed
next
fix C' assume "Copt = Some C'"
with eval have "P,E ⊢ ⟨e∙(C'::)M(es),s⇩0⟩ ⇒ ⟨e⇩2,s⇩2'⟩" by simp
thus ?thesis
proof(rule eval_cases)
fix ex' assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw ex',s⇩2'⟩"
from IH1[OF eval_throw wte sconf] show "throw ex = e⇩2 ∧ s⇩2 = s⇩2'" by simp
next
fix es'' ex' s w ws
assume eval_val:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨Val w,s⟩"
and evals_throw:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val ws@throw ex'#es'',s⇩2'⟩"
and e2:"e⇩2 = throw ex'"
from IH1[OF eval_val wte sconf] have eq:"s = s⇩1" by simp
with wf eval_val wte sconf have sconf':"P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF evals_throw[simplified eq] wtes this] e2
have "vs = ws ∧ ex = ex' ∧ es' = es'' ∧ s⇩2 = s⇩2'"
by(fastforce dest:map_Val_throw_eq)
with e2 show "throw ex = e⇩2 ∧ s⇩2 = s⇩2'" by simp
next
fix C' Xs Xs' Ds' S' U U' Us Us' a' body'' body''' h h' l l' pns'' pns'''
s ws ws'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs),s⟩"
and evals_vals:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val ws,(h,l)⟩"
from IH1[OF eval_ref wte sconf] have eq:"s = s⇩1" by simp
with wf eval_ref wte sconf have sconf':"P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF evals_vals[simplified eq] wtes this]
show "throw ex = e⇩2 ∧ s⇩2 = s⇩2'"
by(fastforce dest:sym[THEN map_Val_throw_False])
next
fix s ws
assume eval_null:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⟩"
and evals_vals:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val ws,s⇩2'⟩"
and e2:"e⇩2 = THROW NullPointer"
from IH1[OF eval_null wte sconf] have eq:"s = s⇩1" by simp
with wf eval_null wte sconf have sconf':"P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF evals_vals[simplified eq] wtes this]
show "throw ex = e⇩2 ∧ s⇩2 = s⇩2'"
by(fastforce dest:sym[THEN map_Val_throw_False])
qed
qed
next
case (Call E e s⇩0 a Cs s⇩1 es vs h⇩2 l⇩2 C S M Ts' T' pns' body' Ds Ts T pns
body Cs' vs' l⇩2' new_body e' h⇩3 l⇩3 e⇩2 s⇩2 T'')
have eval:"P,E ⊢ ⟨e∙M(es),s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩"
and eval':"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a,Cs),s⇩1⟩"
and eval'':"P,E ⊢ ⟨es,s⇩1⟩ [⇒] ⟨map Val vs,(h⇩2,l⇩2)⟩" and h2:"h⇩2 a = Some(C,S)"
and has_least:"P ⊢ last Cs has least M = (Ts',T',pns',body') via Ds"
and selects:"P ⊢ (C,Cs@⇩pDs) selects M = (Ts,T,pns,body) via Cs'"
and length:"length vs = length pns" and Casts:"P ⊢ Ts Casts vs to vs'"
and l2':"l⇩2' = [this ↦ Ref (a, Cs'), pns [↦] vs']"
and new_body:"new_body = (case T' of Class D ⇒ ⦇D⦈body | _ ⇒ body)"
and eval_body:"P,E(this ↦ Class (last Cs'), pns [↦] Ts) ⊢
⟨new_body,(h⇩2,l⇩2')⟩ ⇒ ⟨e',(h⇩3,l⇩3)⟩"
and wt:"P,E ⊢ e∙M(es) :: T''" and sconf:"P,E ⊢ s⇩0 √"
and IH1:"⋀ei si T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ ref (a,Cs) = ei ∧ s⇩1 = si"
and IH2:"⋀esi si Ts. ⟦P,E ⊢ ⟨es,s⇩1⟩ [⇒] ⟨esi,si⟩; P,E ⊢ es [::] Ts; P,E ⊢ s⇩1 √⟧
⟹ map Val vs = esi ∧ (h⇩2,l⇩2) = si"
and IH3:"⋀ei si T.
⟦P,E(this ↦ Class (last Cs'), pns [↦] Ts) ⊢ ⟨new_body,(h⇩2,l⇩2')⟩ ⇒ ⟨ei,si⟩;
P,E(this ↦ Class (last Cs'), pns [↦] Ts) ⊢ new_body :: T;
P,E(this ↦ Class (last Cs'), pns [↦] Ts) ⊢ (h⇩2,l⇩2') √⟧
⟹ e' = ei ∧ (h⇩3, l⇩3) = si" by fact+
from wt obtain D Ss Ss' m Cs'' where wte:"P,E ⊢ e :: Class D"
and has_least':"P ⊢ D has least M = (Ss,T'',m) via Cs''"
and wtes:"P,E ⊢ es [::] Ss'" and subs:"P ⊢ Ss' [≤] Ss" by auto
from eval_preserves_type[OF wf eval' sconf wte]
have last:"last Cs = D" by (auto split:if_split_asm)
with has_least has_least' wf
have eq:"Ts' = Ss ∧ T' = T'' ∧ (pns',body') = m ∧ Ds = Cs''"
by(fastforce dest:wf_sees_method_fun)
from wf selects have param_type:"∀T ∈ set Ts. is_type P T"
and return_type:"is_type P T" and TnotNT:"T ≠ NT"
by(auto dest:select_method_wf_mdecl simp:wf_mdecl_def)
from selects wf have subo:"Subobjs P C Cs'"
by(induct rule:SelectMethodDef.induct,
auto simp:FinalOverriderMethodDef_def OverriderMethodDefs_def
MinimalMethodDefs_def LeastMethodDef_def MethodDefs_def)
with wf have "class":"is_class P (last Cs')" by(auto intro!:Subobj_last_isClass)
from eval'' have hext:"hp s⇩1 ⊴ h⇩2" by (cases s⇩1,auto intro: evals_hext)
from wf eval' sconf wte last have "P,E,(hp s⇩1) ⊢ ref(a,Cs) :⇘NT⇙ Class(last Cs)"
by -(rule eval_preserves_type,simp_all)
with hext have "P,E,h⇩2 ⊢ ref(a,Cs) :⇘NT⇙ Class(last Cs)"
by(auto intro:WTrt_hext_mono dest:hext_objD split:if_split_asm)
with h2 have "Subobjs P C Cs" by (auto split:if_split_asm)
hence "P ⊢ Path C to (last Cs) via Cs"
by (auto simp:path_via_def split:if_split_asm)
with selects has_least wf have param_types:"Ts' = Ts ∧ P ⊢ T ≤ T'"
by -(rule select_least_methods_subtypes,simp_all)
from wf selects have wt_body:"P,[this↦Class(last Cs'),pns[↦]Ts] ⊢ body :: T"
and this_not_pns:"this ∉ set pns" and length:"length pns = length Ts"
and dist:"distinct pns"
by(auto dest!:select_method_wf_mdecl simp:wf_mdecl_def)
have "P,[this↦Class(last Cs'),pns[↦]Ts] ⊢ new_body :: T'"
proof(cases "∃C. T' = Class C")
case False with wt_body new_body param_types show ?thesis by(cases T') auto
next
case True
then obtain D' where T':"T' = Class D'" by auto
with wf has_least have "class":"is_class P D'"
by(fastforce dest:has_least_wf_mdecl simp:wf_mdecl_def)
with wf T' TnotNT param_types obtain D'' where T:"T = Class D''"
by(fastforce dest:widen_Class)
with wf return_type T' param_types have "P ⊢ Path D'' to D' unique"
by(simp add:Class_widen_Class)
with wt_body "class" T T' new_body show ?thesis by auto
qed
hence wt_new_body:"P,E(this↦Class(last Cs'),pns[↦]Ts) ⊢ new_body :: T'"
by(fastforce intro:wt_env_mono)
from eval show ?case
proof(rule eval_cases)
fix ex' assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw ex',s⇩2⟩"
from IH1[OF eval_throw wte sconf] show "e' = e⇩2 ∧ (h⇩3, l⇩2) = s⇩2" by simp
next
fix es'' ex' s w ws
assume eval_val:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨Val w,s⟩"
and evals_throw:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val ws@throw ex'#es'',s⇩2⟩"
from IH1[OF eval_val wte sconf] have eq:"s = s⇩1" by simp
with wf eval_val wte sconf have sconf':"P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF evals_throw[simplified eq] wtes this] show "e' = e⇩2 ∧ (h⇩3, l⇩2) = s⇩2"
by(fastforce dest:map_Val_throw_False)
next
fix C' Xs Xs' Ds' S' U U' Us Us' a' body'' body''' h h' l l' pns'' pns''' s ws ws'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs),s⟩"
and evals_vals:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val ws,(h,l)⟩"
and h:"h a' = Some(C',S')"
and has_least'':"P ⊢ last Xs has least M = (Us',U',pns''',body''') via Ds'"
and selects':"P ⊢ (C',Xs@⇩pDs') selects M = (Us,U,pns'',body'') via Xs'"
and length':"length ws = length pns''" and Casts':"P ⊢ Us Casts ws to ws'"
and eval_body':"P,E(this ↦ Class (last Xs'), pns'' [↦] Us) ⊢
⟨case U' of Class D ⇒ ⦇D⦈body'' | _ ⇒ body'',
(h,[this ↦ Ref(a',Xs'), pns'' [↦] ws'])⟩ ⇒ ⟨e⇩2,(h',l')⟩"
and s2:"s⇩2 = (h',l)"
from IH1[OF eval_ref wte sconf] have eq1:"a = a' ∧ Cs = Xs" and s:"s = s⇩1"
by simp_all
with has_least has_least'' wf have eq2:"T' = U' ∧ Ts' = Us' ∧ Ds = Ds'"
by(fastforce dest:wf_sees_method_fun)
from s wf eval_ref wte sconf have sconf':"P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF evals_vals[simplified s] wtes this]
have eq3:"vs = ws ∧ h⇩2 = h ∧ l⇩2 = l"
by(fastforce elim:map_injective simp:inj_on_def)
with eq1 h2 h have eq4:"C = C' ∧ S = S'" by simp
with eq1 eq2 selects selects' wf
have eq5:"Ts = Us ∧ T = U ∧ pns'' = pns ∧ body'' = body ∧ Cs' = Xs'"
by simp(drule_tac mthd'="(Us,U,pns'',body'')" in wf_select_method_fun,auto)
with subs eq param_types have "P ⊢ Ss' [≤] Us" by simp
with wf Casts Casts' param_type wtes evals_vals sconf' s eq eq2 eq3 eq5
have eq6:"vs' = ws'"
by(fastforce intro:Casts_Casts_eq_result)
with eval_body' l2' eq1 eq2 eq3 eq5 new_body
have eval_body'':"P,E(this ↦ Class(last Cs'), pns [↦] Ts) ⊢
⟨new_body,(h⇩2,l⇩2')⟩ ⇒ ⟨e⇩2,(h',l')⟩"
by fastforce
from wf evals_vals wtes sconf' s eq3 have sconf'':"P,E ⊢ (h⇩2,l⇩2) √"
by(fastforce intro:evals_preserves_sconf)
have "P,E(this ↦ Class (last Cs'), pns [↦] Ts) ⊢ (h⇩2,l⇩2') √"
proof(auto simp:sconf_def)
from sconf'' show "P ⊢ h⇩2 √" by(simp add:sconf_def)
next
{ fix V v assume map:"[this ↦ Ref (a,Cs'), pns [↦] vs'] V = Some v"
have "∃T. (E(this ↦ Class (last Cs'), pns [↦] Ts)) V = Some T ∧
P,h⇩2 ⊢ v :≤ T"
proof(cases "V ∈ set (this#pns)")
case False with map show ?thesis by simp
next
case True
hence "V = this ∨ V ∈ set pns" by simp
thus ?thesis
proof(rule disjE)
assume V:"V = this"
with map this_not_pns have "v = Ref(a,Cs')" by simp
with V h2 subo this_not_pns have
"(E(this ↦ Class (last Cs'),pns [↦] Ts)) V = Some(Class (last Cs'))"
and "P,h⇩2 ⊢ v :≤ Class (last Cs')" by simp_all
thus ?thesis by simp
next
assume "V ∈ set pns"
then obtain i where V:"V = pns!i" and length_i:"i < length pns"
by(auto simp:in_set_conv_nth)
from Casts have "length Ts = length vs'"
by(induct rule:Casts_to.induct,auto)
with length have "length pns = length vs'" by simp
with map dist V length_i have v:"v = vs'!i" by(fastforce dest:maps_nth)
from length dist length_i
have env:"(E(this ↦ Class (last Cs'))(pns [↦] Ts)) (pns!i) = Some(Ts!i)"
by(rule_tac E="E(this ↦ Class (last Cs'))" in nth_maps,simp_all)
from wf Casts wtes subs eq param_types eval'' sconf'
have "∀i < length Ts. P,h⇩2 ⊢ vs'!i :≤ Ts!i"
by simp(rule Casts_conf,auto)
with length_i length env V v show ?thesis by simp
qed
qed }
thus "P,h⇩2 ⊢ l⇩2' (:≤)⇩w E(this ↦ Class (last Cs'), pns [↦] Ts)"
using l2' by(simp add:lconf_def)
next
{ fix V Tx assume env:"(E(this ↦ Class (last Cs'), pns [↦] Ts)) V = Some Tx"
have "is_type P Tx"
proof(cases "V ∈ set (this#pns)")
case False
with env sconf'' show ?thesis
by(clarsimp simp:sconf_def envconf_def)
next
case True
hence "V = this ∨ V ∈ set pns" by simp
thus ?thesis
proof(rule disjE)
assume "V = this"
with env this_not_pns have "Tx = Class(last Cs')" by simp
with "class" show ?thesis by simp
next
assume "V ∈ set pns"
then obtain i where V:"V = pns!i" and length_i:"i < length pns"
by(auto simp:in_set_conv_nth)
with dist length env have "Tx = Ts!i" by(fastforce dest:maps_nth)
with length_i length have "Tx ∈ set Ts"
by(fastforce simp:in_set_conv_nth)
with param_type show ?thesis by simp
qed
qed }
thus "P ⊢ E(this ↦ Class (last Cs'), pns [↦] Ts) √" by (simp add:envconf_def)
qed
from IH3[OF eval_body'' wt_new_body this] have "e' = e⇩2 ∧ (h⇩3, l⇩3) = (h',l')" .
with eq3 s2 show "e' = e⇩2 ∧ (h⇩3,l⇩2) = s⇩2" by simp
next
fix s ws
assume eval_null:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⟩"
from IH1[OF eval_null wte sconf] show "e' = e⇩2 ∧ (h⇩3,l⇩2) = s⇩2" by simp
qed
next
case (StaticCall E e s⇩0 a Cs s⇩1 es vs h⇩2 l⇩2 C Cs'' M Ts T pns body Cs'
Ds vs' l⇩2' e' h⇩3 l⇩3 e⇩2 s⇩2 T')
have eval:"P,E ⊢ ⟨e∙(C::)M(es),s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩"
and eval':"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a,Cs),s⇩1⟩"
and eval'':"P,E ⊢ ⟨es,s⇩1⟩ [⇒] ⟨map Val vs,(h⇩2, l⇩2)⟩"
and path_unique:"P ⊢ Path last Cs to C unique"
and path_via:"P ⊢ Path last Cs to C via Cs''"
and has_least:"P ⊢ C has least M = (Ts,T,pns,body) via Cs'"
and Ds:"Ds = (Cs@⇩pCs'')@⇩pCs'" and length:"length vs = length pns"
and Casts:"P ⊢ Ts Casts vs to vs'"
and l2':"l⇩2' = [this ↦ Ref (a, Ds), pns [↦] vs']"
and eval_body:"P,E(this ↦ Class (last Ds), pns [↦] Ts) ⊢
⟨body,(h⇩2,l⇩2')⟩ ⇒ ⟨e',(h⇩3,l⇩3)⟩"
and wt:"P,E ⊢ e∙(C::)M(es) :: T'" and sconf:"P,E ⊢ s⇩0 √"
and IH1:"⋀ei si T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ ref (a,Cs) = ei ∧ s⇩1 = si"
and IH2:"⋀esi si Ts.
⟦P,E ⊢ ⟨es,s⇩1⟩ [⇒] ⟨esi,si⟩; P,E ⊢ es [::] Ts; P,E ⊢ s⇩1 √⟧
⟹ map Val vs = esi ∧ (h⇩2,l⇩2) = si"
and IH3:"⋀ei si T.
⟦P,E(this ↦ Class (last Ds), pns [↦] Ts) ⊢ ⟨body,(h⇩2,l⇩2')⟩ ⇒ ⟨ei,si⟩;
P,E(this ↦ Class (last Ds), pns [↦] Ts) ⊢ body :: T;
P,E(this ↦ Class (last Ds), pns [↦] Ts) ⊢ (h⇩2,l⇩2') √⟧
⟹ e' = ei ∧ (h⇩3, l⇩3) = si" by fact+
from wt has_least wf obtain C' Ts' where wte:"P,E ⊢ e :: Class C'"
and wtes:"P,E ⊢ es [::] Ts'" and subs:"P ⊢ Ts' [≤] Ts"
by(auto dest:wf_sees_method_fun)
from eval_preserves_type[OF wf eval' sconf wte]
have last:"last Cs = C'" by (auto split:if_split_asm)
from wf has_least have param_type:"∀T ∈ set Ts. is_type P T"
and return_type:"is_type P T" and TnotNT:"T ≠ NT"
by(auto dest:has_least_wf_mdecl simp:wf_mdecl_def)
from path_via have last':"last Cs'' = last(Cs@⇩pCs'')"
by(fastforce intro!:appendPath_last Subobjs_nonempty simp:path_via_def)
from eval'' have hext:"hp s⇩1 ⊴ h⇩2" by (cases s⇩1,auto intro: evals_hext)
from wf eval' sconf wte last have "P,E,(hp s⇩1) ⊢ ref(a,Cs) :⇘NT⇙ Class(last Cs)"
by -(rule eval_preserves_type,simp_all)
with hext have "P,E,h⇩2 ⊢ ref(a,Cs) :⇘NT⇙ Class(last Cs)"
by(auto intro:WTrt_hext_mono dest:hext_objD split:if_split_asm)
then obtain D S where h2:"h⇩2 a = Some(D,S)" and "Subobjs P D Cs"
by (auto split:if_split_asm)
with path_via wf have "Subobjs P D (Cs@⇩pCs'')" and "last Cs'' = C"
by(auto intro:Subobjs_appendPath simp:path_via_def)
with has_least wf last' Ds have subo:"Subobjs P D Ds"
by(fastforce intro:Subobjs_appendPath simp:LeastMethodDef_def MethodDefs_def)
with wf have "class":"is_class P (last Ds)" by(auto intro!:Subobj_last_isClass)
from has_least wf obtain D' where "Subobjs P D' Cs'"
by(auto simp:LeastMethodDef_def MethodDefs_def)
with Ds have last_Ds:"last Cs' = last Ds"
by(fastforce intro!:appendPath_last Subobjs_nonempty)
with wf has_least have "P,[this↦Class(last Ds),pns[↦]Ts] ⊢ body :: T"
and this_not_pns:"this ∉ set pns" and length:"length pns = length Ts"
and dist:"distinct pns"
by(auto dest!:has_least_wf_mdecl simp:wf_mdecl_def)
hence wt_body:"P,E(this↦Class(last Ds),pns[↦]Ts) ⊢ body :: T"
by(fastforce intro:wt_env_mono)
from eval show ?case
proof(rule eval_cases)
fix ex' assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw ex',s⇩2⟩"
from IH1[OF eval_throw wte sconf] show "e' = e⇩2 ∧ (h⇩3, l⇩2) = s⇩2" by simp
next
fix es'' ex' s w ws
assume eval_val:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨Val w,s⟩"
and evals_throw:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val ws@throw ex'#es'',s⇩2⟩"
from IH1[OF eval_val wte sconf] have eq:"s = s⇩1" by simp
with wf eval_val wte sconf have sconf':"P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF evals_throw[simplified eq] wtes this] show "e' = e⇩2 ∧ (h⇩3, l⇩2) = s⇩2"
by(fastforce dest:map_Val_throw_False)
next
fix Xs Xs' Xs'' U Us a' body' h h' l l' pns' s ws ws'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs),s⟩"
and evals_vals:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val ws,(h,l)⟩"
and path_unique':"P ⊢ Path last Xs to C unique"
and path_via':"P ⊢ Path last Xs to C via Xs''"
and has_least':"P ⊢ C has least M = (Us,U,pns',body') via Xs'"
and length':"length ws = length pns'"
and Casts':"P ⊢ Us Casts ws to ws'"
and eval_body':"P,E(this ↦ Class(last((Xs@⇩pXs'')@⇩pXs')),pns' [↦] Us) ⊢
⟨body',(h,[this ↦ Ref(a',(Xs@⇩pXs'')@⇩pXs'),pns' [↦] ws'])⟩ ⇒ ⟨e⇩2,(h',l')⟩"
and s2:"s⇩2 = (h',l)"
from IH1[OF eval_ref wte sconf] have eq1:"a = a' ∧ Cs = Xs" and s:"s = s⇩1"
by simp_all
from has_least has_least' wf
have eq2:"T = U ∧ Ts = Us ∧ Cs' = Xs' ∧ pns = pns' ∧ body = body'"
by(fastforce dest:wf_sees_method_fun)
from s wf eval_ref wte sconf have sconf':"P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF evals_vals[simplified s] wtes this]
have eq3:"vs = ws ∧ h⇩2 = h ∧ l⇩2 = l"
by(fastforce elim:map_injective simp:inj_on_def)
from path_unique path_via path_via' eq1 have "Cs'' = Xs''"
by(fastforce simp:path_unique_def path_via_def)
with Ds eq1 eq2 have Ds':"Ds = (Xs@⇩pXs'')@⇩pXs'" by simp
from wf Casts Casts' param_type wtes subs evals_vals sconf' s eq2 eq3
have eq4:"vs' = ws'"
by(fastforce intro:Casts_Casts_eq_result)
with eval_body' Ds' l2' eq1 eq2 eq3
have eval_body'':"P,E(this ↦ Class(last Ds),pns [↦] Ts) ⊢
⟨body,(h⇩2,l⇩2')⟩ ⇒ ⟨e⇩2,(h',l')⟩"
by simp
from wf evals_vals wtes sconf' s eq3 have sconf'':"P,E ⊢ (h⇩2,l⇩2) √"
by(fastforce intro:evals_preserves_sconf)
have "P,E(this ↦ Class (last Ds), pns [↦] Ts) ⊢ (h⇩2,l⇩2') √"
proof(auto simp:sconf_def)
from sconf'' show "P ⊢ h⇩2 √" by(simp add:sconf_def)
next
{ fix V v assume map:"[this ↦ Ref (a,Ds), pns [↦] vs'] V = Some v"
have "∃T. (E(this ↦ Class (last Ds), pns [↦] Ts)) V = Some T ∧
P,h⇩2 ⊢ v :≤ T"
proof(cases "V ∈ set (this#pns)")
case False with map show ?thesis by simp
next
case True
hence "V = this ∨ V ∈ set pns" by simp
thus ?thesis
proof(rule disjE)
assume V:"V = this"
with map this_not_pns have "v = Ref(a,Ds)" by simp
with V h2 subo this_not_pns have
"(E(this ↦ Class (last Ds),pns [↦] Ts)) V = Some(Class (last Ds))"
and "P,h⇩2 ⊢ v :≤ Class (last Ds)" by simp_all
thus ?thesis by simp
next
assume "V ∈ set pns"
then obtain i where V:"V = pns!i" and length_i:"i < length pns"
by(auto simp:in_set_conv_nth)
from Casts have "length Ts = length vs'"
by(induct rule:Casts_to.induct,auto)
with length have "length pns = length vs'" by simp
with map dist V length_i have v:"v = vs'!i" by(fastforce dest:maps_nth)
from length dist length_i
have env:"(E(this ↦ Class (last Ds))(pns [↦] Ts)) (pns!i) = Some(Ts!i)"
by(rule_tac E="E(this ↦ Class (last Ds))" in nth_maps,simp_all)
from wf Casts wtes subs eval'' sconf'
have "∀i < length Ts. P,h⇩2 ⊢ vs'!i :≤ Ts!i"
by -(rule Casts_conf,auto)
with length_i length env V v show ?thesis by simp
qed
qed }
thus "P,h⇩2 ⊢ l⇩2' (:≤)⇩w E(this ↦ Class (last Ds), pns [↦] Ts)"
using l2' by(simp add:lconf_def)
next
{ fix V Tx assume env:"(E(this ↦ Class (last Ds), pns [↦] Ts)) V = Some Tx"
have "is_type P Tx"
proof(cases "V ∈ set (this#pns)")
case False
with env sconf'' show ?thesis
by(clarsimp simp:sconf_def envconf_def)
next
case True
hence "V = this ∨ V ∈ set pns" by simp
thus ?thesis
proof(rule disjE)
assume "V = this"
with env this_not_pns have "Tx = Class(last Ds)" by simp
with "class" show ?thesis by simp
next
assume "V ∈ set pns"
then obtain i where V:"V = pns!i" and length_i:"i < length pns"
by(auto simp:in_set_conv_nth)
with dist length env have "Tx = Ts!i" by(fastforce dest:maps_nth)
with length_i length have "Tx ∈ set Ts"
by(fastforce simp:in_set_conv_nth)
with param_type show ?thesis by simp
qed
qed }
thus "P ⊢ E(this ↦ Class (last Ds), pns [↦] Ts) √" by (simp add:envconf_def)
qed
from IH3[OF eval_body'' wt_body this] have "e' = e⇩2 ∧ (h⇩3, l⇩3) = (h',l')" .
with eq3 s2 show "e' = e⇩2 ∧ (h⇩3, l⇩2) = s⇩2" by simp
next
fix s ws
assume eval_null:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⟩"
from IH1[OF eval_null wte sconf] show "e' = e⇩2 ∧ (h⇩3,l⇩2) = s⇩2" by simp
qed
next
case (CallNull E e s⇩0 s⇩1 es vs s⇩2 Copt M e⇩2 s⇩2' T)
have eval:"P,E ⊢ ⟨Call e Copt M es,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2'⟩"
and wt:"P,E ⊢ Call e Copt M es :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH1:"⋀ei si T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ null = ei ∧ s⇩1 = si"
and IH2:"⋀esi si Ts. ⟦P,E ⊢ ⟨es,s⇩1⟩ [⇒] ⟨esi,si⟩; P,E ⊢ es [::] Ts; P,E ⊢ s⇩1 √⟧
⟹ map Val vs = esi ∧ s⇩2 = si" by fact+
from wt obtain C Ts where wte:"P,E ⊢ e :: Class C" and wtes:"P,E ⊢ es [::] Ts"
by(cases Copt)auto
show ?case
proof(cases Copt)
assume "Copt = None"
with eval have "P,E ⊢ ⟨e∙M(es),s⇩0⟩ ⇒ ⟨e⇩2,s⇩2'⟩" by simp
thus ?thesis
proof(rule eval_cases)
fix ex' assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw ex',s⇩2'⟩"
from IH1[OF eval_throw wte sconf] show "THROW NullPointer = e⇩2 ∧ s⇩2 = s⇩2'"
by simp
next
fix es' ex' s w ws
assume eval_val:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨Val w,s⟩"
and evals_throw:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val ws@throw ex'#es',s⇩2'⟩"
from IH1[OF eval_val wte sconf] have eq:"s = s⇩1" by simp
with wf eval_val wte sconf have sconf':"P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF evals_throw[simplified eq] wtes this]
show "THROW NullPointer = e⇩2 ∧ s⇩2 = s⇩2'" by(fastforce dest:map_Val_throw_False)
next
fix C' Xs Xs' Ds' S' U U' Us Us' a' body'' body''' h h' l l' pns'' pns'''
s ws ws'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs),s⟩"
from IH1[OF eval_ref wte sconf] show "THROW NullPointer = e⇩2 ∧ s⇩2 = s⇩2'"
by simp
next
fix s ws
assume eval_null:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⟩"
and evals_vals:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val ws,s⇩2'⟩"
and e2:"e⇩2 = THROW NullPointer"
from IH1[OF eval_null wte sconf] have eq:"s = s⇩1" by simp
with wf eval_null wte sconf have sconf':"P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF evals_vals[simplified eq] wtes this] e2
show "THROW NullPointer = e⇩2 ∧ s⇩2 = s⇩2'" by simp
qed
next
fix C' assume "Copt = Some C'"
with eval have "P,E ⊢ ⟨e∙(C'::)M(es),s⇩0⟩ ⇒ ⟨e⇩2,s⇩2'⟩" by simp
thus ?thesis
proof(rule eval_cases)
fix ex' assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw ex',s⇩2'⟩"
from IH1[OF eval_throw wte sconf] show "THROW NullPointer = e⇩2 ∧ s⇩2 = s⇩2'"
by simp
next
fix es' ex' s w ws
assume eval_val:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨Val w,s⟩"
and evals_throw:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val ws@throw ex'#es',s⇩2'⟩"
from IH1[OF eval_val wte sconf] have eq:"s = s⇩1" by simp
with wf eval_val wte sconf have sconf':"P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF evals_throw[simplified eq] wtes this]
show "THROW NullPointer = e⇩2 ∧ s⇩2 = s⇩2'" by(fastforce dest:map_Val_throw_False)
next
fix C' Xs Xs' Ds' S' U U' Us Us' a' body'' body''' h h' l l' pns'' pns'''
s ws ws'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref(a',Xs),s⟩"
from IH1[OF eval_ref wte sconf] show "THROW NullPointer = e⇩2 ∧ s⇩2 = s⇩2'"
by simp
next
fix s ws
assume eval_null:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⟩"
and evals_vals:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val ws,s⇩2'⟩"
and e2:"e⇩2 = THROW NullPointer"
from IH1[OF eval_null wte sconf] have eq:"s = s⇩1" by simp
with wf eval_null wte sconf have sconf':"P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF evals_vals[simplified eq] wtes this] e2
show "THROW NullPointer = e⇩2 ∧ s⇩2 = s⇩2'" by simp
qed
qed
next
case (Block E V T e⇩0 h⇩0 l⇩0 e⇩1 h⇩1 l⇩1 e⇩2 s⇩2 T')
have eval:"P,E ⊢ ⟨{V:T; e⇩0},(h⇩0, l⇩0)⟩ ⇒ ⟨e⇩2,s⇩2⟩"
and wt:"P,E ⊢ {V:T; e⇩0} :: T'" and sconf:"P,E ⊢ (h⇩0, l⇩0) √"
and IH:"⋀e⇩2 s⇩2 T'. ⟦P,E(V ↦ T) ⊢ ⟨e⇩0,(h⇩0, l⇩0(V := None))⟩ ⇒ ⟨e⇩2,s⇩2⟩;
P,E(V ↦ T) ⊢ e⇩0 :: T'; P,E(V ↦ T) ⊢ (h⇩0, l⇩0(V := None)) √⟧
⟹ e⇩1 = e⇩2 ∧ (h⇩1, l⇩1) = s⇩2" by fact+
from wt have type:"is_type P T" and wte:"P,E(V ↦ T) ⊢ e⇩0 :: T'" by auto
from sconf type have sconf':"P,E(V ↦ T) ⊢ (h⇩0, l⇩0(V := None)) √"
by(auto simp:sconf_def lconf_def envconf_def)
from eval obtain h l where
eval':"P,E(V ↦ T) ⊢ ⟨e⇩0,(h⇩0,l⇩0(V:=None))⟩ ⇒ ⟨e⇩2,(h,l)⟩"
and s2:"s⇩2 = (h,l(V:=l⇩0 V))" by (auto elim:eval_cases)
from IH[OF eval' wte sconf'] s2 show ?case by simp
next
case (Seq E e⇩0 s⇩0 v s⇩1 e⇩1 e⇩2 s⇩2 e⇩2' s⇩2' T)
have eval:"P,E ⊢ ⟨e⇩0;; e⇩1,s⇩0⟩ ⇒ ⟨e⇩2',s⇩2'⟩"
and wt:"P,E ⊢ e⇩0;; e⇩1 :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH1:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩0,s⇩0⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩0 :: T; P,E ⊢ s⇩0 √⟧
⟹ Val v = ei ∧ s⇩1 = si"
and IH2:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩1,s⇩1⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩1 :: T; P,E ⊢ s⇩1 √⟧
⟹ e⇩2 = ei ∧ s⇩2 = si" by fact+
from wt obtain T' where wte0:"P,E ⊢ e⇩0 :: T'" and wte1:"P,E ⊢ e⇩1 :: T" by auto
from eval show ?case
proof(rule eval_cases)
fix s w
assume eval_val:"P,E ⊢ ⟨e⇩0,s⇩0⟩ ⇒ ⟨Val w,s⟩"
and eval':"P,E ⊢ ⟨e⇩1,s⟩ ⇒ ⟨e⇩2',s⇩2'⟩"
from IH1[OF eval_val wte0 sconf] have eq:"s = s⇩1" by simp
with wf eval_val wte0 sconf have "P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF eval'[simplified eq] wte1 this] show "e⇩2 = e⇩2' ∧ s⇩2 = s⇩2'" .
next
fix ex assume eval_throw:"P,E ⊢ ⟨e⇩0,s⇩0⟩ ⇒ ⟨throw ex,s⇩2'⟩"
from IH1[OF eval_throw wte0 sconf] show "e⇩2 = e⇩2' ∧ s⇩2 = s⇩2'" by simp
qed
next
case (SeqThrow E e⇩0 s⇩0 e s⇩1 e⇩1 e⇩2 s⇩2 T)
have eval:"P,E ⊢ ⟨e⇩0;; e⇩1,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩"
and wt:"P,E ⊢ e⇩0;; e⇩1 :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩0,s⇩0⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩0 :: T; P,E ⊢ s⇩0 √⟧
⟹ throw e = ei ∧ s⇩1 = si" by fact+
from wt obtain T' where wte0:"P,E ⊢ e⇩0 :: T'" by auto
from eval show ?case
proof(rule eval_cases)
fix s w
assume eval_val:"P,E ⊢ ⟨e⇩0,s⇩0⟩ ⇒ ⟨Val w,s⟩"
from IH[OF eval_val wte0 sconf] show "throw e = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix ex
assume eval_throw:"P,E ⊢ ⟨e⇩0,s⇩0⟩ ⇒ ⟨throw ex,s⇩2⟩" and e2:"e⇩2 = throw ex"
from IH[OF eval_throw wte0 sconf] e2 show "throw e = e⇩2 ∧ s⇩1 = s⇩2" by simp
qed
next
case (CondT E e s⇩0 s⇩1 e⇩1 e' s⇩2 e⇩2 e⇩2' s⇩2' T)
have eval:"P,E ⊢ ⟨if (e) e⇩1 else e⇩2,s⇩0⟩ ⇒ ⟨e⇩2',s⇩2'⟩"
and wt:"P,E ⊢ if (e) e⇩1 else e⇩2 :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH1:"⋀ei si T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ true = ei ∧ s⇩1 = si"
and IH2:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩1,s⇩1⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩1 :: T; P,E ⊢ s⇩1 √⟧
⟹ e' = ei ∧ s⇩2 = si" by fact+
from wt have wte:"P,E ⊢ e :: Boolean" and wte1:"P,E ⊢ e⇩1 :: T" by auto
from eval show ?case
proof(rule eval_cases)
fix s
assume eval_true:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨true,s⟩" and eval':"P,E ⊢ ⟨e⇩1,s⟩ ⇒ ⟨e⇩2',s⇩2'⟩"
from IH1[OF eval_true wte sconf] have eq:"s = s⇩1" by simp
with wf eval_true wte sconf have "P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF eval'[simplified eq] wte1 this] show "e' = e⇩2' ∧ s⇩2 = s⇩2'" .
next
fix s assume eval_false:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨false,s⟩"
from IH1[OF eval_false wte sconf] show "e' = e⇩2' ∧ s⇩2 = s⇩2'" by simp
next
fix ex assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw ex,s⇩2'⟩"
from IH1[OF eval_throw wte sconf] show "e' = e⇩2' ∧ s⇩2 = s⇩2'" by simp
qed
next
case (CondF E e s⇩0 s⇩1 e⇩2 e' s⇩2 e⇩1 e⇩2' s⇩2' T)
have eval:"P,E ⊢ ⟨if (e) e⇩1 else e⇩2,s⇩0⟩ ⇒ ⟨e⇩2',s⇩2'⟩"
and wt:"P,E ⊢ if (e) e⇩1 else e⇩2 :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH1:"⋀ei si T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ false = ei ∧ s⇩1 = si"
and IH2:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩2,s⇩1⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩2 :: T; P,E ⊢ s⇩1 √⟧
⟹ e' = ei ∧ s⇩2 = si" by fact+
from wt have wte:"P,E ⊢ e :: Boolean" and wte2:"P,E ⊢ e⇩2 :: T" by auto
from eval show ?case
proof(rule eval_cases)
fix s
assume eval_true:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨true,s⟩"
from IH1[OF eval_true wte sconf] show "e' = e⇩2' ∧ s⇩2 = s⇩2'" by simp
next
fix s
assume eval_false:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨false,s⟩"
and eval':"P,E ⊢ ⟨e⇩2,s⟩ ⇒ ⟨e⇩2',s⇩2'⟩"
from IH1[OF eval_false wte sconf] have eq:"s = s⇩1" by simp
with wf eval_false wte sconf have "P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF eval'[simplified eq] wte2 this] show "e' = e⇩2' ∧ s⇩2 = s⇩2'" .
next
fix ex assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw ex,s⇩2'⟩"
from IH1[OF eval_throw wte sconf] show "e' = e⇩2' ∧ s⇩2 = s⇩2'" by simp
qed
next
case (CondThrow E e s⇩0 e' s⇩1 e⇩1 e⇩2 e⇩2' s⇩2 T)
have eval:"P,E ⊢ ⟨if (e) e⇩1 else e⇩2,s⇩0⟩ ⇒ ⟨e⇩2',s⇩2⟩"
and wt:"P,E ⊢ if (e) e⇩1 else e⇩2 :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH:"⋀ei si T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ throw e' = ei ∧ s⇩1 = si" by fact+
from wt have wte:"P,E ⊢ e :: Boolean" by auto
from eval show ?case
proof(rule eval_cases)
fix s
assume eval_true:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨true,s⟩"
from IH[OF eval_true wte sconf] show "throw e' = e⇩2' ∧ s⇩1 = s⇩2" by simp
next
fix s assume eval_false:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨false,s⟩"
from IH[OF eval_false wte sconf] show "throw e' = e⇩2' ∧ s⇩1 = s⇩2" by simp
next
fix ex
assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw ex,s⇩2⟩" and e2':"e⇩2' = throw ex"
from IH[OF eval_throw wte sconf] e2' show "throw e' = e⇩2' ∧ s⇩1 = s⇩2" by simp
qed
next
case (WhileF E e s⇩0 s⇩1 c e⇩2 s⇩2 T)
have eval:"P,E ⊢ ⟨while (e) c,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩"
and wt:"P,E ⊢ while (e) c :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH:"⋀e⇩2 s⇩2 T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ false = e⇩2 ∧ s⇩1 = s⇩2" by fact+
from wt have wte:"P,E ⊢ e :: Boolean" by auto
from eval show ?case
proof(rule eval_cases)
assume eval_false:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨false,s⇩2⟩" and e2:"e⇩2 = unit"
from IH[OF eval_false wte sconf] e2 show "unit = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix s s' w
assume eval_true:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨true,s⟩"
from IH[OF eval_true wte sconf] show "unit = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix ex assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw ex,s⇩2⟩"
from IH[OF eval_throw wte sconf] show "unit = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix ex s
assume eval_true:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨true,s⟩"
from IH[OF eval_true wte sconf] show "unit = e⇩2 ∧ s⇩1 = s⇩2" by simp
qed
next
case (WhileT E e s⇩0 s⇩1 c v⇩1 s⇩2 e⇩3 s⇩3 e⇩2 s⇩2' T)
have eval:"P,E ⊢ ⟨while (e) c,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2'⟩"
and wt:"P,E ⊢ while (e) c :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH1:"⋀ei si T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ true = ei ∧ s⇩1 = si"
and IH2:"⋀ei si T. ⟦P,E ⊢ ⟨c,s⇩1⟩ ⇒ ⟨ei,si⟩; P,E ⊢ c :: T; P,E ⊢ s⇩1 √⟧
⟹ Val v⇩1 = ei ∧ s⇩2 = si"
and IH3:"⋀ei si T. ⟦P,E ⊢ ⟨while (e) c,s⇩2⟩ ⇒ ⟨ei,si⟩; P,E ⊢ while (e) c :: T;
P,E ⊢ s⇩2 √⟧
⟹ e⇩3 = ei ∧ s⇩3 = si" by fact+
from wt obtain T' where wte:"P,E ⊢ e :: Boolean" and wtc:"P,E ⊢ c :: T'" by auto
from eval show ?case
proof(rule eval_cases)
assume eval_false:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨false,s⇩2'⟩"
from IH1[OF eval_false wte sconf] show "e⇩3 = e⇩2 ∧ s⇩3 = s⇩2'" by simp
next
fix s s' w
assume eval_true:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨true,s⟩"
and eval_val:"P,E ⊢ ⟨c,s⟩ ⇒ ⟨Val w,s'⟩"
and eval_while:"P,E ⊢ ⟨while (e) c,s'⟩ ⇒ ⟨e⇩2,s⇩2'⟩"
from IH1[OF eval_true wte sconf] have eq:"s = s⇩1" by simp
with wf eval_true wte sconf have sconf':"P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF eval_val[simplified eq] wtc this] have eq':"s' = s⇩2" by simp
with wf eval_val wtc sconf' eq have "P,E ⊢ s⇩2 √"
by(fastforce intro:eval_preserves_sconf)
from IH3[OF eval_while[simplified eq'] wt this] show "e⇩3 = e⇩2 ∧ s⇩3 = s⇩2'" .
next
fix ex assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw ex,s⇩2'⟩"
from IH1[OF eval_throw wte sconf] show "e⇩3 = e⇩2 ∧ s⇩3 = s⇩2'" by simp
next
fix ex s
assume eval_true:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨true,s⟩"
and eval_throw:"P,E ⊢ ⟨c,s⟩ ⇒ ⟨throw ex,s⇩2'⟩"
from IH1[OF eval_true wte sconf] have eq:"s = s⇩1" by simp
with wf eval_true wte sconf have sconf':"P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF eval_throw[simplified eq] wtc this] show "e⇩3 = e⇩2 ∧ s⇩3 = s⇩2'" by simp
qed
next
case (WhileCondThrow E e s⇩0 e' s⇩1 c e⇩2 s⇩2 T)
have eval:"P,E ⊢ ⟨while (e) c,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩"
and wt:"P,E ⊢ while (e) c :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH:"⋀ei si T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ throw e' = ei ∧ s⇩1 = si" by fact+
from wt have wte:"P,E ⊢ e :: Boolean" by auto
from eval show ?case
proof(rule eval_cases)
assume eval_false:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨false,s⇩2⟩"
from IH[OF eval_false wte sconf] show "throw e' = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix s s' w
assume eval_true:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨true,s⟩"
from IH[OF eval_true wte sconf] show "throw e' = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix ex
assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw ex,s⇩2⟩" and e2:"e⇩2 = throw ex"
from IH[OF eval_throw wte sconf] e2 show "throw e' = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix ex s
assume eval_true:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨true,s⟩"
from IH[OF eval_true wte sconf] show "throw e' = e⇩2 ∧ s⇩1 = s⇩2" by simp
qed
next
case (WhileBodyThrow E e s⇩0 s⇩1 c e' s⇩2 e⇩2 s⇩2' T)
have eval:"P,E ⊢ ⟨while (e) c,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2'⟩"
and wt:"P,E ⊢ while (e) c :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH1:"⋀ei si T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ true = ei ∧ s⇩1 = si"
and IH2:"⋀ei si T. ⟦P,E ⊢ ⟨c,s⇩1⟩ ⇒ ⟨ei,si⟩; P,E ⊢ c :: T; P,E ⊢ s⇩1 √⟧
⟹ throw e' = ei ∧ s⇩2 = si" by fact+
from wt obtain T' where wte:"P,E ⊢ e :: Boolean" and wtc:"P,E ⊢ c :: T'" by auto
from eval show ?case
proof(rule eval_cases)
assume eval_false:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨false,s⇩2'⟩"
from IH1[OF eval_false wte sconf] show "throw e' = e⇩2 ∧ s⇩2 = s⇩2'" by simp
next
fix s s' w
assume eval_true:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨true,s⟩"
and eval_val:"P,E ⊢ ⟨c,s⟩ ⇒ ⟨Val w,s'⟩"
from IH1[OF eval_true wte sconf] have eq:"s = s⇩1" by simp
with wf eval_true wte sconf have sconf':"P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF eval_val[simplified eq] wtc this] show "throw e' = e⇩2 ∧ s⇩2 = s⇩2'"
by simp
next
fix ex assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw ex,s⇩2'⟩"
from IH1[OF eval_throw wte sconf] show "throw e' = e⇩2 ∧ s⇩2 = s⇩2'" by simp
next
fix ex s
assume eval_true:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨true,s⟩"
and eval_throw:"P,E ⊢ ⟨c,s⟩ ⇒ ⟨throw ex,s⇩2'⟩" and e2:"e⇩2 = throw ex"
from IH1[OF eval_true wte sconf] have eq:"s = s⇩1" by simp
with wf eval_true wte sconf have sconf':"P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF eval_throw[simplified eq] wtc this] e2 show "throw e' = e⇩2 ∧ s⇩2 = s⇩2'"
by simp
qed
next
case (Throw E e s⇩0 r s⇩1 e⇩2 s⇩2 T)
have eval:"P,E ⊢ ⟨throw e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩"
and wt:"P,E ⊢ throw e :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH:"⋀ei si T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ ref r = ei ∧ s⇩1 = si" by fact+
from wt obtain C where wte:"P,E ⊢ e :: Class C" by auto
from eval show ?case
proof(rule eval_cases)
fix r'
assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref r',s⇩2⟩" and e2:"e⇩2 = Throw r'"
from IH[OF eval_ref wte sconf] e2 show "Throw r = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
assume eval_null:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⇩2⟩"
from IH[OF eval_null wte sconf] show "Throw r = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix ex assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw ex,s⇩2⟩"
from IH[OF eval_throw wte sconf] show "Throw r = e⇩2 ∧ s⇩1 = s⇩2" by simp
qed
next
case (ThrowNull E e s⇩0 s⇩1 e⇩2 s⇩2 T)
have eval:"P,E ⊢ ⟨throw e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩"
and wt:"P,E ⊢ throw e :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH:"⋀ei si T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ null = ei ∧ s⇩1 = si" by fact+
from wt obtain C where wte:"P,E ⊢ e :: Class C" by auto
from eval show ?case
proof(rule eval_cases)
fix r' assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref r',s⇩2⟩"
from IH[OF eval_ref wte sconf] show "THROW NullPointer = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
assume eval_null:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⇩2⟩" and e2:"e⇩2 = THROW NullPointer"
from IH[OF eval_null wte sconf] e2 show "THROW NullPointer = e⇩2 ∧ s⇩1 = s⇩2"
by simp
next
fix ex assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw ex,s⇩2⟩"
from IH[OF eval_throw wte sconf] show "THROW NullPointer = e⇩2 ∧ s⇩1 = s⇩2" by simp
qed
next
case (ThrowThrow E e s⇩0 e' s⇩1 e⇩2 s⇩2 T)
have eval:"P,E ⊢ ⟨throw e,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩"
and wt:"P,E ⊢ throw e :: T" and sconf:"P,E ⊢ s⇩0 √"
and IH:"⋀ei si T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ throw e' = ei ∧ s⇩1 = si" by fact+
from wt obtain C where wte:"P,E ⊢ e :: Class C" by auto
from eval show ?case
proof(rule eval_cases)
fix r' assume eval_ref:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ref r',s⇩2⟩"
from IH[OF eval_ref wte sconf] show "throw e' = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
assume eval_null:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⇩2⟩"
from IH[OF eval_null wte sconf] show "throw e' = e⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix ex
assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw ex,s⇩2⟩" and e2:"e⇩2 = throw ex"
from IH[OF eval_throw wte sconf] e2 show "throw e' = e⇩2 ∧ s⇩1 = s⇩2" by simp
qed
next
case Nil thus ?case by (auto elim:evals_cases)
next
case (Cons E e s⇩0 v s⇩1 es es' s⇩2 es⇩2 s⇩2' Ts)
have evals:"P,E ⊢ ⟨e#es,s⇩0⟩ [⇒] ⟨es⇩2,s⇩2'⟩"
and wt:"P,E ⊢ e#es [::] Ts" and sconf:"P,E ⊢ s⇩0 √"
and IH1:"⋀ei si T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ Val v = ei ∧ s⇩1 = si"
and IH2:"⋀esi si Ts. ⟦P,E ⊢ ⟨es,s⇩1⟩ [⇒] ⟨esi,si⟩; P,E ⊢ es [::] Ts; P,E ⊢ s⇩1 √⟧
⟹ es' = esi ∧ s⇩2 = si" by fact+
from wt obtain T' Ts' where Ts:"Ts = T'#Ts'" by(cases Ts) auto
with wt have wte:"P,E ⊢ e :: T'" and wtes:"P,E ⊢ es [::] Ts'" by auto
from evals show ?case
proof(rule evals_cases)
fix es'' s w
assume eval_val:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨Val w,s⟩"
and evals_vals:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨es'',s⇩2'⟩" and es2:"es⇩2 = Val w#es''"
from IH1[OF eval_val wte sconf] have s:"s = s⇩1" and v:"v = w" by simp_all
with wf eval_val wte sconf have "P,E ⊢ s⇩1 √"
by(fastforce intro:eval_preserves_sconf)
from IH2[OF evals_vals[simplified s] wtes this] have "es' = es'' ∧ s⇩2 = s⇩2'" .
with es2 v show "Val v # es' = es⇩2 ∧ s⇩2 = s⇩2'" by simp
next
fix ex assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw ex,s⇩2'⟩"
from IH1[OF eval_throw wte sconf] show "Val v # es' = es⇩2 ∧ s⇩2 = s⇩2'" by simp
qed
next
case (ConsThrow E e s⇩0 e' s⇩1 es es⇩2 s⇩2 Ts)
have evals:"P,E ⊢ ⟨e#es,s⇩0⟩ [⇒] ⟨es⇩2,s⇩2⟩"
and wt:"P,E ⊢ e#es [::] Ts" and sconf:"P,E ⊢ s⇩0 √"
and IH:"⋀ei si T. ⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e :: T; P,E ⊢ s⇩0 √⟧
⟹ throw e' = ei ∧ s⇩1 = si" by fact+
from wt obtain T' Ts' where Ts:"Ts = T'#Ts'" by(cases Ts) auto
with wt have wte:"P,E ⊢ e :: T'" by auto
from evals show ?case
proof(rule evals_cases)
fix es'' s w
assume eval_val:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨Val w,s⟩"
from IH[OF eval_val wte sconf] show "throw e'#es = es⇩2 ∧ s⇩1 = s⇩2" by simp
next
fix ex
assume eval_throw:"P,E ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw ex,s⇩2⟩" and es2:"es⇩2 = throw ex#es"
from IH[OF eval_throw wte sconf] es2 show "throw e'#es = es⇩2 ∧ s⇩1 = s⇩2" by simp
qed
qed
end
Theory Annotate
section ‹Program annotation›
theory Annotate imports WellType begin
abbreviation (output)
unanFAcc :: "expr ⇒ vname ⇒ expr" ("(_∙_)" [10,10] 90) where
"unanFAcc e F == FAcc e F []"
abbreviation (output)
unanFAss :: "expr ⇒ vname ⇒ expr ⇒ expr" ("(_∙_ := _)" [10,0,90] 90) where
"unanFAss e F e' == FAss e F [] e'"
inductive
Anno :: "[prog,env, expr , expr] ⇒ bool"
("_,_ ⊢ _ ↝ _" [51,0,0,51]50)
and Annos :: "[prog,env, expr list, expr list] ⇒ bool"
("_,_ ⊢ _ [↝] _" [51,0,0,51]50)
for P :: prog
where
AnnoNew: "is_class P C ⟹ P,E ⊢ new C ↝ new C"
| AnnoCast: "P,E ⊢ e ↝ e' ⟹ P,E ⊢ Cast C e ↝ Cast C e'"
| AnnoStatCast: "P,E ⊢ e ↝ e' ⟹ P,E ⊢ StatCast C e ↝ StatCast C e'"
| AnnoVal: "P,E ⊢ Val v ↝ Val v"
| AnnoVarVar: "E V = ⌊T⌋ ⟹ P,E ⊢ Var V ↝ Var V"
| AnnoVarField: "⟦ E V = None; E this = ⌊Class C⌋; P ⊢ C has least V:T via Cs ⟧
⟹ P,E ⊢ Var V ↝ Var this∙V{Cs}"
| AnnoBinOp:
"⟦ P,E ⊢ e1 ↝ e1'; P,E ⊢ e2 ↝ e2' ⟧
⟹ P,E ⊢ e1 «bop» e2 ↝ e1' «bop» e2'"
| AnnoLAss:
"P,E ⊢ e ↝ e' ⟹ P,E ⊢ V:=e ↝ V:=e'"
| AnnoFAcc:
"⟦ P,E ⊢ e ↝ e'; P,E ⊢ e' :: Class C; P ⊢ C has least F:T via Cs ⟧
⟹ P,E ⊢ e∙F{[]} ↝ e'∙F{Cs}"
| AnnoFAss: "⟦ P,E ⊢ e1 ↝ e1'; P,E ⊢ e2 ↝ e2';
P,E ⊢ e1' :: Class C; P ⊢ C has least F:T via Cs ⟧
⟹ P,E ⊢ e1∙F{[]} := e2 ↝ e1'∙F{Cs} := e2'"
| AnnoCall:
"⟦ P,E ⊢ e ↝ e'; P,E ⊢ es [↝] es' ⟧
⟹ P,E ⊢ Call e Copt M es ↝ Call e' Copt M es'"
| AnnoBlock:
"P,E(V ↦ T) ⊢ e ↝ e' ⟹ P,E ⊢ {V:T; e} ↝ {V:T; e'}"
| AnnoComp: "⟦ P,E ⊢ e1 ↝ e1'; P,E ⊢ e2 ↝ e2' ⟧
⟹ P,E ⊢ e1;;e2 ↝ e1';;e2'"
| AnnoCond: "⟦ P,E ⊢ e ↝ e'; P,E ⊢ e1 ↝ e1'; P,E ⊢ e2 ↝ e2' ⟧
⟹ P,E ⊢ if (e) e1 else e2 ↝ if (e') e1' else e2'"
| AnnoLoop: "⟦ P,E ⊢ e ↝ e'; P,E ⊢ c ↝ c' ⟧
⟹ P,E ⊢ while (e) c ↝ while (e') c'"
| AnnoThrow: "P,E ⊢ e ↝ e' ⟹ P,E ⊢ throw e ↝ throw e'"
| AnnoNil: "P,E ⊢ [] [↝] []"
| AnnoCons: "⟦ P,E ⊢ e ↝ e'; P,E ⊢ es [↝] es' ⟧
⟹ P,E ⊢ e#es [↝] e'#es'"
end
Theory Execute
section ‹Code generation for Semantics and Type System›
theory Execute
imports BigStep WellType
"HOL-Library.AList_Mapping"
"HOL-Library.Code_Target_Numeral"
begin
subsection‹General redefinitions›
inductive app :: "'a list ⇒ 'a list ⇒ 'a list ⇒ bool"
where
"app [] ys ys"
| "app xs ys zs ⟹ app (x # xs) ys (x # zs)"
theorem app_eq1: "⋀ys zs. zs = xs @ ys ⟹ app xs ys zs"
apply (induct xs)
apply simp
apply (rule app.intros)
apply simp
apply (iprover intro: app.intros)
done
theorem app_eq2: "app xs ys zs ⟹ zs = xs @ ys"
by (erule app.induct) simp_all
theorem app_eq: "app xs ys zs = (zs = xs @ ys)"
apply (rule iffI)
apply (erule app_eq2)
apply (erule app_eq1)
done
code_pred
(modes:
i ⇒ i ⇒ i ⇒ bool, i ⇒ i ⇒ o ⇒ bool, i ⇒ o ⇒ i ⇒ bool,
o ⇒ i ⇒ i ⇒ bool, o ⇒ o ⇒ i ⇒ bool as reverse_app)
app
.
declare rtranclp_rtrancl_eq[code del]
lemmas [code_pred_intro] = rtranclp.rtrancl_refl converse_rtranclp_into_rtranclp
code_pred
(modes:
(i => o => bool) => i => i => bool,
(i => o => bool) => i => o => bool)
rtranclp
by(erule converse_rtranclpE) blast+
definition Set_project :: "('a × 'b) set => 'a => 'b set"
where "Set_project A a = {b. (a, b) ∈ A}"
lemma Set_project_set [code]:
"Set_project (set xs) a = set (List.map_filter (λ(a', b). if a = a' then Some b else None) xs)"
by(auto simp add: Set_project_def map_filter_def intro: rev_image_eqI split: if_split_asm)
text‹Redefine map Val vs›
inductive map_val :: "expr list ⇒ val list ⇒ bool"
where
Nil: "map_val [] []"
| Cons: "map_val xs ys ⟹ map_val (Val y # xs) (y # ys)"
code_pred
(modes: i ⇒ i ⇒ bool, i ⇒ o ⇒ bool)
map_val
.
inductive map_val2 :: "expr list ⇒ val list ⇒ expr list ⇒ bool"
where
Nil: "map_val2 [] [] []"
| Cons: "map_val2 xs ys zs ⟹ map_val2 (Val y # xs) (y # ys) zs"
| Throw: "map_val2 (throw e # xs) [] (throw e # xs)"
code_pred
(modes: i ⇒ i ⇒ i ⇒ bool, i ⇒ o ⇒ o ⇒ bool)
map_val2
.
theorem map_val_conv: "(xs = map Val ys) = map_val xs ys"
proof -
have "⋀ys. xs = map Val ys ⟹ map_val xs ys"
apply (induct xs type:list)
apply (case_tac ys)
apply simp
apply (rule map_val.Nil)
apply simp
apply (case_tac ys)
apply simp
apply simp
apply (rule map_val.Cons)
apply simp
done
moreover have "map_val xs ys ⟹ xs = map Val ys"
by (erule map_val.induct) simp+
ultimately show ?thesis ..
qed
theorem map_val2_conv:
"(xs = map Val ys @ throw e # zs) = map_val2 xs ys (throw e # zs)"
proof -
have "⋀ys. xs = map Val ys @ throw e # zs ⟹ map_val2 xs ys (throw e # zs)"
apply (induct xs type:list)
apply (case_tac ys)
apply simp
apply simp
apply simp
apply (case_tac ys)
apply simp
apply (rule map_val2.Throw)
apply simp
apply (rule map_val2.Cons)
apply simp
done
moreover have "map_val2 xs ys (throw e # zs) ⟹ xs = map Val ys @ throw e # zs"
by (erule map_val2.induct) simp+
ultimately show ?thesis ..
qed
subsection‹Code generation›
lemma subclsRp_code [code_pred_intro]:
"⟦ class P C = ⌊(Bs, rest)⌋; Predicate_Compile.contains (set Bs) (Repeats D) ⟧ ⟹ subclsRp P C D"
by(auto intro: subclsRp.intros simp add: contains_def)
code_pred
(modes: i ⇒ i ⇒ i ⇒ bool, i ⇒ i ⇒ o ⇒ bool)
subclsRp
by(erule subclsRp.cases)(fastforce simp add: Predicate_Compile.contains_def)
lemma subclsR_code [code_pred_inline]:
"P ⊢ C ≺⇩R D ⟷ subclsRp P C D"
by(simp add: subclsR_def)
lemma subclsSp_code [code_pred_intro]:
"⟦ class P C = ⌊(Bs, rest)⌋; Predicate_Compile.contains (set Bs) (Shares D) ⟧ ⟹ subclsSp P C D"
by(auto intro: subclsSp.intros simp add: Predicate_Compile.contains_def)
code_pred
(modes: i ⇒ i ⇒ i ⇒ bool, i ⇒ i ⇒ o ⇒ bool)
subclsSp
by(erule subclsSp.cases)(fastforce simp add: Predicate_Compile.contains_def)
declare SubobjsR_Base [code_pred_intro]
lemma SubobjsR_Rep_code [code_pred_intro]:
"⟦subclsRp P C D; Subobjs⇩R P D Cs⟧ ⟹ Subobjs⇩R P C (C # Cs)"
by(simp add: SubobjsR_Rep subclsR_def)
code_pred
(modes: i ⇒ i ⇒ i ⇒ bool, i ⇒ i ⇒ o ⇒ bool)
Subobjs⇩R
by(erule Subobjs⇩R.cases)(auto simp add: subclsR_code)
lemma subcls1p_code [code_pred_intro]:
"⟦class P C = Some (Bs,rest); Predicate_Compile.contains (baseClasses Bs) D ⟧ ⟹ subcls1p P C D"
by(auto intro: subcls1p.intros simp add: Predicate_Compile.contains_def)
code_pred (modes: i ⇒ i ⇒ i ⇒ bool, i ⇒ i ⇒ o ⇒ bool)
subcls1p
by(fastforce elim!: subcls1p.cases simp add: Predicate_Compile.contains_def)
declare Subobjs_Rep [code_pred_intro]
lemma Subobjs_Sh_code [code_pred_intro]:
"⟦ (subcls1p P)^** C C'; subclsSp P C' D; Subobjs⇩R P D Cs⟧
⟹ Subobjs P C Cs"
by(rule Subobjs_Sh)(simp_all add: rtrancl_def subcls1_def subclsS_def)
code_pred
(modes: i ⇒ i ⇒ i ⇒ bool, i ⇒ i ⇒ o ⇒ bool)
Subobjs
by(erule Subobjs.cases)(auto simp add: rtrancl_def subcls1_def subclsS_def)
definition widen_unique :: "prog ⇒ cname ⇒ cname ⇒ path ⇒ bool"
where "widen_unique P C D Cs ⟷ (∀Cs'. Subobjs P C Cs' ⟶ last Cs' = D ⟶ Cs = Cs')"
code_pred [inductify, skip_proof] widen_unique .
lemma widen_subcls':
"⟦Subobjs P C Cs'; last Cs' = D; widen_unique P C D Cs' ⟧
⟹ P ⊢ Class C ≤ Class D"
by(rule widen_subcls,auto simp:path_unique_def widen_unique_def)
declare
widen_refl [code_pred_intro]
widen_subcls' [code_pred_intro widen_subcls]
widen_null [code_pred_intro]
code_pred
(modes: i ⇒ i ⇒ i ⇒ bool)
widen
by(erule widen.cases)(auto simp add: path_unique_def widen_unique_def)
code_pred
(modes: i ⇒ i ⇒ i ⇒ i ⇒ bool, i ⇒ i ⇒ i ⇒ o ⇒ bool, i ⇒ i ⇒ o ⇒ i ⇒ bool, i ⇒ i ⇒ o ⇒ o ⇒ bool)
leq_path1p
.
lemma leq_path_unfold: "P,C ⊢ Cs ⊑ Ds ⟷ (leq_path1p P C)^** Cs Ds"
by(simp add: leq_path1_def rtrancl_def)
code_pred
(modes: i => i => i => o => bool, i => i => i => i => bool)
[inductify,skip_proof]
path_via
.
lemma path_unique_eq [code_pred_def]: "P ⊢ Path C to D unique ⟷
(∃Cs. Subobjs P C Cs ∧ last Cs = D ∧ (∀Cs'. Subobjs P C Cs' ⟶ last Cs' = D ⟶ Cs = Cs'))"
by(auto simp add: path_unique_def)
code_pred
(modes: i => i => o => bool, i => i => i => bool)
[inductify, skip_proof]
path_unique .
text ‹Redefine MethodDefs and FieldDecls›
definition MethodDefs' :: "prog ⇒ cname ⇒ mname ⇒ path ⇒ method ⇒ bool" where
"MethodDefs' P C M Cs mthd ≡ (Cs, mthd) ∈ MethodDefs P C M"
lemma [code_pred_intro]:
"Subobjs P C Cs ⟹ class P (last Cs) = ⌊(Bs,fs,ms)⌋ ⟹ map_of ms M = ⌊mthd⌋ ⟹
MethodDefs' P C M Cs mthd"
by (simp add: MethodDefs_def MethodDefs'_def)
code_pred
(modes: i ⇒ i ⇒ i ⇒ o ⇒ o ⇒ bool, i ⇒ i ⇒ i ⇒ i ⇒ i ⇒ bool)
MethodDefs'
by(fastforce simp add: MethodDefs_def MethodDefs'_def)
definition FieldDecls' :: "prog ⇒ cname ⇒ vname ⇒ path ⇒ ty ⇒ bool" where
"FieldDecls' P C F Cs T ≡ (Cs, T) ∈ FieldDecls P C F"
lemma [code_pred_intro]:
"Subobjs P C Cs ⟹ class P (last Cs) = ⌊(Bs,fs,ms)⌋ ⟹ map_of fs F = ⌊T⌋ ⟹
FieldDecls' P C F Cs T"
by (simp add: FieldDecls_def FieldDecls'_def)
code_pred
(modes: i ⇒ i ⇒ i ⇒ o ⇒ o ⇒ bool, i ⇒ i ⇒ i ⇒ i ⇒ i ⇒ bool)
FieldDecls'
by(fastforce simp add: FieldDecls_def FieldDecls'_def)
definition MinimalMethodDefs' :: "prog ⇒ cname ⇒ mname ⇒ path ⇒ method ⇒ bool" where
"MinimalMethodDefs' P C M Cs mthd ≡ (Cs, mthd) ∈ MinimalMethodDefs P C M"
definition MinimalMethodDefs_unique :: "prog ⇒ cname ⇒ mname ⇒ path ⇒ bool"
where
"MinimalMethodDefs_unique P C M Cs ⟷
(∀Cs' mthd. MethodDefs' P C M Cs' mthd ⟶ (leq_path1p P C)^** Cs' Cs ⟶ Cs' = Cs)"
code_pred [inductify, skip_proof] MinimalMethodDefs_unique .
lemma [code_pred_intro]:
"MethodDefs' P C M Cs mthd ⟹ MinimalMethodDefs_unique P C M Cs ⟹
MinimalMethodDefs' P C M Cs mthd"
by (fastforce simp add:MinimalMethodDefs_def MinimalMethodDefs'_def MethodDefs'_def MinimalMethodDefs_unique_def leq_path_unfold)
code_pred
(modes: i ⇒ i ⇒ i ⇒ o ⇒ o ⇒ bool)
MinimalMethodDefs'
by(fastforce simp add:MinimalMethodDefs_def MinimalMethodDefs'_def MethodDefs'_def MinimalMethodDefs_unique_def leq_path_unfold)
definition LeastMethodDef_unique :: "prog ⇒ cname ⇒ mname ⇒ path ⇒ bool"
where
"LeastMethodDef_unique P C M Cs ⟷
(∀Cs' mthd'. MethodDefs' P C M Cs' mthd' ⟶ (leq_path1p P C)^** Cs Cs')"
code_pred [inductify, skip_proof] LeastMethodDef_unique .
lemma LeastMethodDef_unfold:
"P ⊢ C has least M = mthd via Cs ⟷
MethodDefs' P C M Cs mthd ∧ LeastMethodDef_unique P C M Cs"
by(fastforce simp add: LeastMethodDef_def MethodDefs'_def leq_path_unfold LeastMethodDef_unique_def)
lemma LeastMethodDef_intro [code_pred_intro]:
"⟦ MethodDefs' P C M Cs mthd; LeastMethodDef_unique P C M Cs ⟧
⟹ P ⊢ C has least M = mthd via Cs"
by(simp add: LeastMethodDef_unfold LeastMethodDef_unique_def)
code_pred (modes: i => i => i => o => o => bool)
LeastMethodDef
by(simp add: LeastMethodDef_unfold LeastMethodDef_unique_def)
definition OverriderMethodDefs' :: "prog ⇒ subobj ⇒ mname ⇒ path ⇒ method ⇒ bool" where
"OverriderMethodDefs' P R M Cs mthd ≡ (Cs, mthd) ∈ OverriderMethodDefs P R M"
lemma Overrider1 [code_pred_intro]:
"P ⊢ (ldc R) has least M = mthd' via Cs' ⟹
MinimalMethodDefs' P (mdc R) M Cs mthd ⟹
last (snd R) = hd Cs' ⟹ (leq_path1p P (mdc R))^** Cs (snd R @ tl Cs') ⟹
OverriderMethodDefs' P R M Cs mthd"
apply(simp add:OverriderMethodDefs_def OverriderMethodDefs'_def MinimalMethodDefs'_def appendPath_def leq_path_unfold)
apply(rule_tac x="Cs'" in exI)
apply clarsimp
apply(cases mthd')
apply blast
done
lemma Overrider2 [code_pred_intro]:
"P ⊢ (ldc R) has least M = mthd' via Cs' ⟹
MinimalMethodDefs' P (mdc R) M Cs mthd ⟹
last (snd R) ≠ hd Cs' ⟹ (leq_path1p P (mdc R))^** Cs Cs' ⟹
OverriderMethodDefs' P R M Cs mthd"
by(auto simp add:OverriderMethodDefs_def OverriderMethodDefs'_def MinimalMethodDefs'_def appendPath_def leq_path_unfold simp del: split_paired_Ex)
code_pred
(modes: i ⇒ i ⇒ i ⇒ o ⇒ o ⇒ bool, i ⇒ i ⇒ i ⇒ i ⇒ o ⇒ bool, i ⇒ i ⇒ i ⇒ o ⇒ i ⇒ bool, i ⇒ i ⇒ i ⇒ i ⇒ i ⇒ bool)
OverriderMethodDefs'
apply(clarsimp simp add: OverriderMethodDefs'_def MinimalMethodDefs'_def MethodDefs'_def OverriderMethodDefs_def appendPath_def leq_path_unfold)
apply(case_tac "last xb = hd Cs'")
apply(simp)
apply(thin_tac "PROP _")
apply(simp add: leq_path1_def)
done
definition WTDynCast_ex :: "prog ⇒ cname ⇒ cname ⇒ bool"
where "WTDynCast_ex P D C ⟷ (∃Cs. P ⊢ Path D to C via Cs)"
code_pred [inductify, skip_proof] WTDynCast_ex .
lemma WTDynCast_new:
"⟦P,E ⊢ e :: Class D; is_class P C;
P ⊢ Path D to C unique ∨ ¬ WTDynCast_ex P D C⟧
⟹ P,E ⊢ Cast C e :: Class C"
by(rule WTDynCast)(auto simp add: WTDynCast_ex_def)
definition WTStaticCast_sub :: "prog ⇒ cname ⇒ cname ⇒ bool"
where "WTStaticCast_sub P C D ⟷
P ⊢ Path D to C unique ∨
((subcls1p P)^** C D ∧ (∀Cs. P ⊢ Path C to D via Cs ⟶ Subobjs⇩R P C Cs))"
code_pred [inductify, skip_proof] WTStaticCast_sub .
lemma WTStaticCast_new:
"⟦P,E ⊢ e :: Class D; is_class P C; WTStaticCast_sub P C D ⟧
⟹ P,E ⊢ ⦇C⦈e :: Class C"
by (rule WTStaticCast)(auto simp add: WTStaticCast_sub_def subcls1_def rtrancl_def)
lemma WTBinOp1: "⟦ P,E ⊢ e⇩1 :: T; P,E ⊢ e⇩2 :: T⟧
⟹ P,E ⊢ e⇩1 «Eq» e⇩2 :: Boolean"
apply (rule WTBinOp)
apply assumption+
apply simp
done
lemma WTBinOp2: "⟦ P,E ⊢ e⇩1 :: Integer; P,E ⊢ e⇩2 :: Integer ⟧
⟹ P,E ⊢ e⇩1 «Add» e⇩2 :: Integer"
apply (rule WTBinOp)
apply assumption+
apply simp
done
lemma LeastFieldDecl_unfold [code_pred_def]:
"P ⊢ C has least F:T via Cs ⟷
FieldDecls' P C F Cs T ∧ (∀Cs' T'. FieldDecls' P C F Cs' T' ⟶ (leq_path1p P C)^** Cs Cs')"
by(auto simp add: LeastFieldDecl_def FieldDecls'_def leq_path_unfold)
code_pred [inductify, skip_proof] LeastFieldDecl .
lemmas [code_pred_intro] = WT_WTs.WTNew
declare
WTDynCast_new[code_pred_intro WTDynCast_new]
WTStaticCast_new[code_pred_intro WTStaticCast_new]
lemmas [code_pred_intro] = WT_WTs.WTVal WT_WTs.WTVar
declare
WTBinOp1[code_pred_intro WTBinOp1]
WTBinOp2 [code_pred_intro WTBinOp2]
lemmas [code_pred_intro] =
WT_WTs.WTLAss WT_WTs.WTFAcc WT_WTs.WTFAss WT_WTs.WTCall WTStaticCall
WT_WTs.WTBlock WT_WTs.WTSeq WT_WTs.WTCond WT_WTs.WTWhile WT_WTs.WTThrow
lemmas [code_pred_intro] = WT_WTs.WTNil WT_WTs.WTCons
code_pred
(modes: WT: i ⇒ i ⇒ i ⇒ i ⇒ bool, i ⇒ i ⇒ i ⇒ o ⇒ bool
and WTs: i ⇒ i ⇒ i ⇒ i ⇒ bool, i ⇒ i ⇒ i ⇒ o ⇒ bool)
WT
proof -
case WT
from WT.prems show thesis
proof(cases (no_simp) rule: WT.cases)
case WTDynCast thus thesis
by(rule WT.WTDynCast_new[OF refl, unfolded WTDynCast_ex_def, simplified])
next
case WTStaticCast thus ?thesis
unfolding subcls1_def rtrancl_def mem_Collect_eq prod.case
by(rule WT.WTStaticCast_new[OF refl, unfolded WTStaticCast_sub_def])
next
case WTBinOp thus ?thesis
by(split bop.split_asm)(simp_all, (erule (4) WT.WTBinOp1[OF refl] WT.WTBinOp2[OF refl])+)
qed(assumption|erule (2) WT.that[OF refl])+
next
case WTs
from WTs.prems show thesis
by(cases (no_simp) rule: WTs.cases)(assumption|erule (2) WTs.that[OF refl])+
qed
lemma casts_to_code [code_pred_intro]:
"(case T of Class C ⇒ False | _ ⇒ True) ⟹ P ⊢ T casts v to v"
"P ⊢ Class C casts Null to Null"
"⟦Subobjs P (last Cs) Cs'; last Cs' = C;
last Cs = hd Cs'; Cs @ tl Cs' = Ds⟧
⟹ P ⊢ Class C casts Ref(a,Cs) to Ref(a,Ds)"
"⟦Subobjs P (last Cs) Cs'; last Cs' = C; last Cs ≠ hd Cs'⟧
⟹ P ⊢ Class C casts Ref(a,Cs) to Ref(a,Cs')"
by(auto intro: casts_to.intros simp add: path_via_def appendPath_def)
code_pred (modes: i ⇒ i ⇒ i ⇒ o ⇒ bool, i ⇒ i ⇒ i ⇒ i ⇒ bool)
casts_to
apply(erule casts_to.cases)
apply(fastforce split: ty.splits)
apply simp
apply(fastforce simp add: appendPath_def path_via_def split: if_split_asm)
done
code_pred
(modes: i ⇒ i ⇒ i ⇒ o ⇒ bool, i ⇒ i ⇒ i ⇒ i ⇒ bool)
Casts_to
.
lemma card_eq_1_iff_ex1: "x ∈ A ⟹ card A = 1 ⟷ A = {x}"
apply(rule iffI)
apply(rule equalityI)
apply(rule subsetI)
apply(subgoal_tac "card {x, xa} ≤ card A")
apply(auto intro: ccontr)[1]
apply(rule card_mono)
apply simp_all
apply(metis Suc_n_not_n card.infinite)
done
lemma FinalOverriderMethodDef_unfold [code_pred_def]:
"P ⊢ R has overrider M = mthd via Cs ⟷
OverriderMethodDefs' P R M Cs mthd ∧
(∀Cs' mthd'. OverriderMethodDefs' P R M Cs' mthd' ⟶ Cs = Cs' ∧ mthd = mthd')"
by(auto simp add: FinalOverriderMethodDef_def OverriderMethodDefs'_def card_eq_1_iff_ex1 simp del: One_nat_def)
code_pred
(modes: i => i => i => o => o => bool)
[inductify, skip_proof]
FinalOverriderMethodDef
.
code_pred
(modes: i => i => i => i => o => o => bool, i ⇒ i ⇒ i ⇒ i ⇒ i ⇒ i ⇒ bool)
[inductify]
SelectMethodDef
.
text ‹Isomorphic subo with mapping instead of a map›
type_synonym subo' = "(path × (vname, val) mapping)"
type_synonym obj' = "cname × subo' set"
lift_definition init_class_fieldmap' :: "prog ⇒ cname ⇒ (vname, val) mapping" is "init_class_fieldmap" .
lemma init_class_fieldmap'_code [code]:
"init_class_fieldmap' P C =
Mapping (map (λ(F,T).(F,default_val T)) (fst(snd(the(class P C)))) )"
by transfer(simp add: init_class_fieldmap_def)
lift_definition init_obj' :: "prog ⇒ cname ⇒ subo' ⇒ bool" is init_obj .
lemma init_obj'_intros [code_pred_intro]:
"Subobjs P C Cs ⟹ init_obj' P C (Cs, init_class_fieldmap' P (last Cs))"
by(transfer)(rule init_obj.intros)
code_pred
(modes: i ⇒ i ⇒ o ⇒ bool as init_obj_pred)
init_obj'
by transfer(erule init_obj.cases, blast)
lemma init_obj_pred_conv: "set_of_pred (init_obj_pred P C) = Collect (init_obj' P C)"
by(auto elim: init_obj_predE intro: init_obj_predI)
lift_definition blank' :: "prog ⇒ cname ⇒ obj'" is "blank" .
lemma blank'_code [code]:
"blank' P C = (C, set_of_pred (init_obj_pred P C))"
unfolding init_obj_pred_conv by transfer(simp add: blank_def)
type_synonym heap' = "addr ⇀ obj'"
abbreviation
cname_of' :: "heap' ⇒ addr ⇒ cname" where
"⋀hp. cname_of' hp a == fst (the (hp a))"
lift_definition new_Addr' :: "heap' ⇒ addr option" is "new_Addr" .
lift_definition start_heap' :: "prog ⇒ heap'" is "start_heap" .
lemma start_heap'_code [code]:
"start_heap' P = Map.empty (addr_of_sys_xcpt NullPointer ↦ blank' P NullPointer)
(addr_of_sys_xcpt ClassCast ↦ blank' P ClassCast)
(addr_of_sys_xcpt OutOfMemory ↦ blank' P OutOfMemory)"
by transfer(simp add: start_heap_def)
type_synonym
state' = "heap' × locals"
lift_definition hp' :: "state' ⇒ heap'" is hp .
lemma hp'_code [code]: "hp' = fst"
by transfer simp
lift_definition lcl' :: "state' ⇒ locals" is lcl .
lemma lcl_code [code]: "lcl' = snd"
by transfer simp
lift_definition eval' :: "prog ⇒ env ⇒ expr ⇒ state' ⇒ expr ⇒ state' ⇒ bool"
("_,_ ⊢ ((1⟨_,/_⟩) ⇒''/ (1⟨_,/_⟩))" [51,0,0,0,0] 81)
is eval .
lift_definition evals' :: "prog ⇒ env ⇒ expr list ⇒ state' ⇒ expr list ⇒ state' ⇒ bool"
("_,_ ⊢ ((1⟨_,/_⟩) [⇒'']/ (1⟨_,/_⟩))" [51,0,0,0,0] 81)
is evals .
lemma New':
"⟦ new_Addr' h = Some a; h' = h(a↦(blank' P C)) ⟧
⟹ P,E ⊢ ⟨new C,(h,l)⟩ ⇒' ⟨ref (a,[C]),(h',l)⟩"
by transfer(unfold blank_def, rule New)
lemma NewFail':
"new_Addr' h = None ⟹
P,E ⊢ ⟨new C, (h,l)⟩ ⇒' ⟨THROW OutOfMemory,(h,l)⟩"
by transfer(rule NewFail)
lemma StaticUpCast':
"⟦ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨ref (a,Cs),s⇩1⟩; P ⊢ Path last Cs to C via Cs'; Ds = Cs@⇩pCs' ⟧
⟹ P,E ⊢ ⟨⦇C⦈e,s⇩0⟩ ⇒' ⟨ref (a,Ds),s⇩1⟩"
by transfer(rule StaticUpCast)
lemma StaticDownCast'_new:
"⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨ref (a,Ds),s⇩1⟩; app Cs [C] Ds'; app Ds' Cs' Ds⟧
⟹ P,E ⊢ ⟨⦇C⦈e,s⇩0⟩ ⇒' ⟨ref(a,Cs@[C]),s⇩1⟩"
apply transfer
apply (rule StaticDownCast)
apply (simp add: app_eq)
done
lemma StaticCastNull':
"P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨null,s⇩1⟩ ⟹
P,E ⊢ ⟨⦇C⦈e,s⇩0⟩ ⇒' ⟨null,s⇩1⟩"
by transfer(rule StaticCastNull)
lemma StaticCastFail'_new:
"⟦ P,E ⊢ ⟨e,s⇩0⟩⇒' ⟨ref (a,Cs),s⇩1⟩; ¬ (subcls1p P)^** (last Cs) C; C ∉ set Cs⟧
⟹ P,E ⊢ ⟨⦇C⦈e,s⇩0⟩ ⇒' ⟨THROW ClassCast,s⇩1⟩"
apply transfer
by (fastforce intro:StaticCastFail simp add: rtrancl_def subcls1_def)
lemma StaticCastThrow':
"P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨throw e',s⇩1⟩ ⟹
P,E ⊢ ⟨⦇C⦈e,s⇩0⟩ ⇒' ⟨throw e',s⇩1⟩"
by transfer(rule StaticCastThrow)
lemma StaticUpDynCast':
"⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨ref(a,Cs),s⇩1⟩; P ⊢ Path last Cs to C unique;
P ⊢ Path last Cs to C via Cs'; Ds = Cs@⇩pCs' ⟧
⟹ P,E ⊢ ⟨Cast C e,s⇩0⟩ ⇒' ⟨ref(a,Ds),s⇩1⟩"
by transfer(rule StaticUpDynCast)
lemma StaticDownDynCast'_new:
"⟦P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨ref (a,Ds),s⇩1⟩; app Cs [C] Ds'; app Ds' Cs' Ds⟧
⟹ P,E ⊢ ⟨Cast C e,s⇩0⟩ ⇒' ⟨ref(a,Cs@[C]),s⇩1⟩"
apply transfer
apply (rule StaticDownDynCast)
apply (simp add: app_eq)
done
lemma DynCast':
"⟦ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨ref (a,Cs),(h,l)⟩; h a = Some(D,S);
P ⊢ Path D to C via Cs'; P ⊢ Path D to C unique ⟧
⟹ P,E ⊢ ⟨Cast C e,s⇩0⟩ ⇒' ⟨ref (a,Cs'),(h,l)⟩"
by transfer(rule DynCast)
lemma DynCastNull':
"P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨null,s⇩1⟩ ⟹
P,E ⊢ ⟨Cast C e,s⇩0⟩ ⇒' ⟨null,s⇩1⟩"
by transfer(rule DynCastNull)
lemma DynCastFail':
"⟦ P,E ⊢ ⟨e,s⇩0⟩⇒' ⟨ref (a,Cs),(h,l)⟩; h a = Some(D,S); ¬ P ⊢ Path D to C unique;
¬ P ⊢ Path last Cs to C unique; C ∉ set Cs ⟧
⟹ P,E ⊢ ⟨Cast C e,s⇩0⟩ ⇒' ⟨null,(h,l)⟩"
by transfer(rule DynCastFail)
lemma DynCastThrow':
"P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨throw e',s⇩1⟩ ⟹
P,E ⊢ ⟨Cast C e,s⇩0⟩ ⇒' ⟨throw e',s⇩1⟩"
by transfer(rule DynCastThrow)
lemma Val':
"P,E ⊢ ⟨Val v,s⟩ ⇒' ⟨Val v,s⟩"
by transfer(rule Val)
lemma BinOp':
"⟦ P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒' ⟨Val v⇩1,s⇩1⟩; P,E ⊢ ⟨e⇩2,s⇩1⟩ ⇒' ⟨Val v⇩2,s⇩2⟩;
binop(bop,v⇩1,v⇩2) = Some v ⟧
⟹ P,E ⊢ ⟨e⇩1 «bop» e⇩2,s⇩0⟩⇒'⟨Val v,s⇩2⟩"
by transfer(rule BinOp)
lemma BinOpThrow1':
"P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒' ⟨throw e,s⇩1⟩ ⟹
P,E ⊢ ⟨e⇩1 «bop» e⇩2, s⇩0⟩ ⇒' ⟨throw e,s⇩1⟩"
by transfer(rule BinOpThrow1)
lemma BinOpThrow2':
"⟦ P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒' ⟨Val v⇩1,s⇩1⟩; P,E ⊢ ⟨e⇩2,s⇩1⟩ ⇒' ⟨throw e,s⇩2⟩ ⟧
⟹ P,E ⊢ ⟨e⇩1 «bop» e⇩2,s⇩0⟩ ⇒' ⟨throw e,s⇩2⟩"
by transfer(rule BinOpThrow2)
lemma Var':
"l V = Some v ⟹
P,E ⊢ ⟨Var V,(h,l)⟩ ⇒' ⟨Val v,(h,l)⟩"
by transfer(rule Var)
lemma LAss':
"⟦ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨Val v,(h,l)⟩; E V = Some T;
P ⊢ T casts v to v'; l' = l(V↦v') ⟧
⟹ P,E ⊢ ⟨V:=e,s⇩0⟩ ⇒' ⟨Val v',(h,l')⟩"
by (transfer) (erule (3) LAss)
lemma LAssThrow':
"P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨throw e',s⇩1⟩ ⟹
P,E ⊢ ⟨V:=e,s⇩0⟩ ⇒' ⟨throw e',s⇩1⟩"
by transfer(rule LAssThrow)
lemma FAcc'_new:
"⟦ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨ref (a,Cs'),(h,l)⟩; h a = Some(D,S);
Ds = Cs'@⇩pCs; Predicate_Compile.contains (Set_project S Ds) fs; Mapping.lookup fs F = Some v ⟧
⟹ P,E ⊢ ⟨e∙F{Cs},s⇩0⟩ ⇒' ⟨Val v,(h,l)⟩"
unfolding Set_project_def mem_Collect_eq Predicate_Compile.contains_def
by transfer(rule FAcc)
lemma FAccNull':
"P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨null,s⇩1⟩ ⟹
P,E ⊢ ⟨e∙F{Cs},s⇩0⟩ ⇒' ⟨THROW NullPointer,s⇩1⟩"
by transfer(rule FAccNull)
lemma FAccThrow':
"P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨throw e',s⇩1⟩ ⟹
P,E ⊢ ⟨e∙F{Cs},s⇩0⟩ ⇒' ⟨throw e',s⇩1⟩"
by transfer(rule FAccThrow)
lemma FAss'_new:
"⟦ P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒' ⟨ref (a,Cs'),s⇩1⟩; P,E ⊢ ⟨e⇩2,s⇩1⟩ ⇒' ⟨Val v,(h⇩2,l⇩2)⟩;
h⇩2 a = Some(D,S); P ⊢ (last Cs') has least F:T via Cs; P ⊢ T casts v to v';
Ds = Cs'@⇩pCs; Predicate_Compile.contains (Set_project S Ds) fs; fs' = Mapping.update F v' fs;
S' = S - {(Ds,fs)} ∪ {(Ds,fs')}; h⇩2' = h⇩2(a↦(D,S'))⟧
⟹ P,E ⊢ ⟨e⇩1∙F{Cs}:=e⇩2,s⇩0⟩ ⇒' ⟨Val v',(h⇩2',l⇩2)⟩"
unfolding Predicate_Compile.contains_def Set_project_def mem_Collect_eq
by transfer(rule FAss)
lemma FAssNull':
"⟦ P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒' ⟨null,s⇩1⟩; P,E ⊢ ⟨e⇩2,s⇩1⟩ ⇒' ⟨Val v,s⇩2⟩ ⟧ ⟹
P,E ⊢ ⟨e⇩1∙F{Cs}:=e⇩2,s⇩0⟩ ⇒' ⟨THROW NullPointer,s⇩2⟩"
by transfer(rule FAssNull)
lemma FAssThrow1':
"P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒' ⟨throw e',s⇩1⟩ ⟹
P,E ⊢ ⟨e⇩1∙F{Cs}:=e⇩2,s⇩0⟩ ⇒' ⟨throw e',s⇩1⟩"
by transfer(rule FAssThrow1)
lemma FAssThrow2':
"⟦ P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒' ⟨Val v,s⇩1⟩; P,E ⊢ ⟨e⇩2,s⇩1⟩ ⇒' ⟨throw e',s⇩2⟩ ⟧
⟹ P,E ⊢ ⟨e⇩1∙F{Cs}:=e⇩2,s⇩0⟩ ⇒' ⟨throw e',s⇩2⟩"
by transfer(rule FAssThrow2)
lemma CallObjThrow':
"P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨throw e',s⇩1⟩ ⟹
P,E ⊢ ⟨Call e Copt M es,s⇩0⟩ ⇒' ⟨throw e',s⇩1⟩"
by transfer(rule CallObjThrow)
lemma CallParamsThrow'_new:
"⟦ P,E ⊢ ⟨e,s0⟩ ⇒' ⟨Val v,s1⟩; P,E ⊢ ⟨es,s1⟩ [⇒'] ⟨evs,s2⟩;
map_val2 evs vs (throw ex # es') ⟧
⟹ P,E ⊢ ⟨Call e Copt M es,s0⟩ ⇒' ⟨throw ex,s2⟩"
apply transfer
apply(rule eval_evals.CallParamsThrow, assumption+)
apply(simp add: map_val2_conv[symmetric])
done
lemma Call'_new:
"⟦ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨ref (a,Cs),s⇩1⟩; P,E ⊢ ⟨ps,s⇩1⟩ [⇒'] ⟨evs,(h⇩2,l⇩2)⟩;
map_val evs vs;
h⇩2 a = Some(C,S); P ⊢ last Cs has least M = (Ts',T',pns',body') via Ds;
P ⊢ (C,Cs@⇩pDs) selects M = (Ts,T,pns,body) via Cs'; length vs = length pns;
P ⊢ Ts Casts vs to vs'; l⇩2' = [this↦Ref (a,Cs'), pns[↦]vs'];
new_body = (case T' of Class D ⇒ ⦇D⦈body | _ ⇒ body);
P,E(this↦Class(last Cs'), pns[↦]Ts) ⊢ ⟨new_body,(h⇩2,l⇩2')⟩ ⇒' ⟨e',(h⇩3,l⇩3)⟩ ⟧
⟹ P,E ⊢ ⟨e∙M(ps),s⇩0⟩ ⇒' ⟨e',(h⇩3,l⇩2)⟩"
apply transfer
apply(rule Call)
apply assumption+
apply(simp add: map_val_conv[symmetric])
apply assumption+
done
lemma StaticCall'_new:
"⟦ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨ref (a,Cs),s⇩1⟩; P,E ⊢ ⟨ps,s⇩1⟩ [⇒'] ⟨evs,(h⇩2,l⇩2)⟩;
map_val evs vs;
P ⊢ Path (last Cs) to C unique; P ⊢ Path (last Cs) to C via Cs'';
P ⊢ C has least M = (Ts,T,pns,body) via Cs'; Ds = (Cs@⇩pCs'')@⇩pCs';
length vs = length pns; P ⊢ Ts Casts vs to vs';
l⇩2' = [this↦Ref (a,Ds), pns[↦]vs'];
P,E(this↦Class(last Ds), pns[↦]Ts) ⊢ ⟨body,(h⇩2,l⇩2')⟩ ⇒' ⟨e',(h⇩3,l⇩3)⟩ ⟧
⟹ P,E ⊢ ⟨e∙(C::)M(ps),s⇩0⟩ ⇒' ⟨e',(h⇩3,l⇩2)⟩"
apply transfer
apply(rule StaticCall)
apply(assumption)+
apply(simp add: map_val_conv[symmetric])
apply assumption+
done
lemma CallNull'_new:
"⟦ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨null,s⇩1⟩; P,E ⊢ ⟨es,s⇩1⟩ [⇒'] ⟨evs,s⇩2⟩; map_val evs vs ⟧
⟹ P,E ⊢ ⟨Call e Copt M es,s⇩0⟩ ⇒' ⟨THROW NullPointer,s⇩2⟩"
apply transfer
apply(rule CallNull, assumption+)
apply(simp add: map_val_conv[symmetric])
done
lemma Block':
"⟦P,E(V ↦ T) ⊢ ⟨e⇩0,(h⇩0,l⇩0(V:=None))⟩ ⇒' ⟨e⇩1,(h⇩1,l⇩1)⟩ ⟧ ⟹
P,E ⊢ ⟨{V:T; e⇩0},(h⇩0,l⇩0)⟩ ⇒' ⟨e⇩1,(h⇩1,l⇩1(V:=l⇩0 V))⟩"
by transfer(rule Block)
lemma Seq':
"⟦ P,E ⊢ ⟨e⇩0,s⇩0⟩ ⇒' ⟨Val v,s⇩1⟩; P,E ⊢ ⟨e⇩1,s⇩1⟩ ⇒' ⟨e⇩2,s⇩2⟩ ⟧
⟹ P,E ⊢ ⟨e⇩0;;e⇩1,s⇩0⟩ ⇒' ⟨e⇩2,s⇩2⟩"
by transfer(rule Seq)
lemma SeqThrow':
"P,E ⊢ ⟨e⇩0,s⇩0⟩ ⇒' ⟨throw e,s⇩1⟩ ⟹
P,E ⊢ ⟨e⇩0;;e⇩1,s⇩0⟩⇒'⟨throw e,s⇩1⟩"
by transfer(rule SeqThrow)
lemma CondT':
"⟦ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨true,s⇩1⟩; P,E ⊢ ⟨e⇩1,s⇩1⟩ ⇒' ⟨e',s⇩2⟩ ⟧
⟹ P,E ⊢ ⟨if (e) e⇩1 else e⇩2,s⇩0⟩ ⇒' ⟨e',s⇩2⟩"
by transfer(rule CondT)
lemma CondF':
"⟦ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨false,s⇩1⟩; P,E ⊢ ⟨e⇩2,s⇩1⟩ ⇒' ⟨e',s⇩2⟩ ⟧
⟹ P,E ⊢ ⟨if (e) e⇩1 else e⇩2,s⇩0⟩ ⇒' ⟨e',s⇩2⟩"
by transfer(rule CondF)
lemma CondThrow':
"P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨throw e',s⇩1⟩ ⟹
P,E ⊢ ⟨if (e) e⇩1 else e⇩2, s⇩0⟩ ⇒' ⟨throw e',s⇩1⟩"
by transfer(rule CondThrow)
lemma WhileF':
"P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨false,s⇩1⟩ ⟹
P,E ⊢ ⟨while (e) c,s⇩0⟩ ⇒' ⟨unit,s⇩1⟩"
by transfer(rule WhileF)
lemma WhileT':
"⟦ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨true,s⇩1⟩; P,E ⊢ ⟨c,s⇩1⟩ ⇒' ⟨Val v⇩1,s⇩2⟩;
P,E ⊢ ⟨while (e) c,s⇩2⟩ ⇒' ⟨e⇩3,s⇩3⟩ ⟧
⟹ P,E ⊢ ⟨while (e) c,s⇩0⟩ ⇒' ⟨e⇩3,s⇩3⟩"
by transfer(rule WhileT)
lemma WhileCondThrow':
"P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨ throw e',s⇩1⟩ ⟹
P,E ⊢ ⟨while (e) c,s⇩0⟩ ⇒' ⟨throw e',s⇩1⟩"
by transfer(rule WhileCondThrow)
lemma WhileBodyThrow':
"⟦ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨true,s⇩1⟩; P,E ⊢ ⟨c,s⇩1⟩ ⇒' ⟨throw e',s⇩2⟩⟧
⟹ P,E ⊢ ⟨while (e) c,s⇩0⟩ ⇒' ⟨throw e',s⇩2⟩"
by transfer(rule WhileBodyThrow)
lemma Throw':
"P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨ref r,s⇩1⟩ ⟹
P,E ⊢ ⟨throw e,s⇩0⟩ ⇒' ⟨Throw r,s⇩1⟩"
by transfer(rule eval_evals.Throw)
lemma ThrowNull':
"P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨null,s⇩1⟩ ⟹
P,E ⊢ ⟨throw e,s⇩0⟩ ⇒' ⟨THROW NullPointer,s⇩1⟩"
by transfer(rule ThrowNull)
lemma ThrowThrow':
"P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨throw e',s⇩1⟩ ⟹
P,E ⊢ ⟨throw e,s⇩0⟩ ⇒' ⟨throw e',s⇩1⟩"
by transfer(rule ThrowThrow)
lemma Nil':
"P,E ⊢ ⟨[],s⟩ [⇒'] ⟨[],s⟩"
by transfer(rule eval_evals.Nil)
lemma Cons':
"⟦ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨Val v,s⇩1⟩; P,E ⊢ ⟨es,s⇩1⟩ [⇒'] ⟨es',s⇩2⟩ ⟧
⟹ P,E ⊢ ⟨e#es,s⇩0⟩ [⇒'] ⟨Val v # es',s⇩2⟩"
by transfer(rule eval_evals.Cons)
lemma ConsThrow':
"P,E ⊢ ⟨e, s⇩0⟩ ⇒' ⟨throw e', s⇩1⟩ ⟹
P,E ⊢ ⟨e#es, s⇩0⟩ [⇒'] ⟨throw e' # es, s⇩1⟩"
by transfer(rule ConsThrow)
text ‹Axiomatic heap address model refinement›
partial_function (option) lowest :: "(nat ⇒ bool) ⇒ nat ⇒ nat option"
where
[code]: "lowest P n = (if P n then Some n else lowest P (Suc n))"
axiomatization
where
new_Addr'_code [code]: "new_Addr' h = lowest (Option.is_none ∘ h) 0"
lemma eval'_cases
[consumes 1,
case_names New NewFail StaticUpCast StaticDownCast StaticCastNull StaticCastFail
StaticCastThrow StaticUpDynCast StaticDownDynCast DynCast DynCastNull DynCastFail
DynCastThrow Val BinOp BinOpThrow1 BinOpThrow2 Var LAss LAssThrow FAcc FAccNull FAccThrow
FAss FAssNull FAssThrow1 FAssThrow2 CallObjThrow CallParamsThrow Call StaticCall CallNull
Block Seq SeqThrow CondT CondF CondThrow WhileF WhileT WhileCondThrow WhileBodyThrow
Throw ThrowNull ThrowThrow]:
assumes "P,x ⊢ ⟨y,z⟩ ⇒' ⟨u,v⟩"
and "⋀h a h' C E l. x = E ⟹ y = new C ⟹ z = (h, l) ⟹ u = ref (a, [C]) ⟹
v = (h', l) ⟹ new_Addr' h = ⌊a⌋ ⟹ h' = h(a ↦ blank' P C) ⟹ thesis"
and "⋀h E C l. x = E ⟹ y = new C ⟹ z = (h, l) ⟹
u = Throw (addr_of_sys_xcpt OutOfMemory, [OutOfMemory]) ⟹
v = (h, l) ⟹ new_Addr' h = None ⟹ thesis"
and "⋀E e s⇩0 a Cs s⇩1 C Cs' Ds. x = E ⟹ y = ⦇C⦈e ⟹ z = s⇩0 ⟹
u = ref (a, Ds) ⟹ v = s⇩1 ⟹ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨ref (a, Cs),s⇩1⟩ ⟹
P ⊢ Path last Cs to C via Cs' ⟹ Ds = Cs @⇩p Cs' ⟹ thesis"
and "⋀E e s⇩0 a Cs C Cs' s⇩1. x = E ⟹ y = ⦇C⦈e ⟹ z = s⇩0 ⟹ u = ref (a, Cs @ [C]) ⟹
v = s⇩1 ⟹ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨ref (a, Cs @ [C] @ Cs'),s⇩1⟩ ⟹ thesis"
and "⋀E e s⇩0 s⇩1 C. x = E ⟹ y = ⦇C⦈e ⟹ z = s⇩0 ⟹ u = null ⟹ v = s⇩1 ⟹
P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨null,s⇩1⟩ ⟹ thesis"
and "⋀E e s⇩0 a Cs s⇩1 C. x = E ⟹ y = ⦇C⦈e ⟹ z = s⇩0 ⟹
u = Throw (addr_of_sys_xcpt ClassCast, [ClassCast]) ⟹ v = s⇩1 ⟹
P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨ref (a, Cs),s⇩1⟩ ⟹ (last Cs, C) ∉ (subcls1 P)⇧* ⟹ C ∉ set Cs ⟹ thesis"
and "⋀E e s⇩0 e' s⇩1 C. x = E ⟹ y = ⦇C⦈e ⟹ z = s⇩0 ⟹ u = throw e' ⟹ v = s⇩1 ⟹
P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨throw e',s⇩1⟩ ⟹ thesis"
and "⋀E e s⇩0 a Cs s⇩1 C Cs' Ds. x = E ⟹ y = Cast C e ⟹ z = s⇩0 ⟹ u = ref (a, Ds) ⟹
v = s⇩1 ⟹ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨ref (a, Cs),s⇩1⟩ ⟹ P ⊢ Path last Cs to C unique ⟹
P ⊢ Path last Cs to C via Cs' ⟹ Ds = Cs @⇩p Cs' ⟹ thesis"
and "⋀E e s⇩0 a Cs C Cs' s⇩1. x = E ⟹ y = Cast C e ⟹ z = s⇩0 ⟹
u = ref (a, Cs @ [C]) ⟹ v = s⇩1 ⟹ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨ref (a, Cs @ [C] @ Cs'),s⇩1⟩ ⟹ thesis"
and "⋀E e s⇩0 a Cs h l D S C Cs'. x = E ⟹ y = Cast C e ⟹ z = s⇩0 ⟹
u = ref (a, Cs') ⟹ v = (h, l) ⟹ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨ref (a, Cs),(h, l)⟩ ⟹
h a = ⌊(D, S)⌋ ⟹ P ⊢ Path D to C via Cs' ⟹ P ⊢ Path D to C unique ⟹ thesis"
and "⋀E e s⇩0 s⇩1 C. x = E ⟹ y = Cast C e ⟹ z = s⇩0 ⟹ u = null ⟹ v = s⇩1 ⟹
P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨null,s⇩1⟩ ⟹ thesis"
and "⋀E e s⇩0 a Cs h l D S C. x = E ⟹ y = Cast C e ⟹ z = s⇩0 ⟹ u = null ⟹
v = (h, l) ⟹ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨ref (a, Cs),(h, l)⟩ ⟹ h a = ⌊(D, S)⌋ ⟹
¬ P ⊢ Path D to C unique ⟹ ¬ P ⊢ Path last Cs to C unique ⟹ C ∉ set Cs ⟹ thesis"
and "⋀E e s⇩0 e' s⇩1 C. x = E ⟹ y = Cast C e ⟹ z = s⇩0 ⟹ u = throw e' ⟹ v = s⇩1
⟹ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨throw e',s⇩1⟩ ⟹ thesis"
and "⋀E va s. x = E ⟹ y = Val va ⟹ z = s ⟹ u = Val va ⟹ v = s ⟹ thesis"
and "⋀E e⇩1 s⇩0 v⇩1 s⇩1 e⇩2 v⇩2 s⇩2 bop va. x = E ⟹ y = e⇩1 «bop» e⇩2 ⟹ z = s⇩0 ⟹
u = Val va ⟹ v = s⇩2 ⟹ P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒' ⟨Val v⇩1,s⇩1⟩ ⟹
P,E ⊢ ⟨e⇩2,s⇩1⟩ ⇒' ⟨Val v⇩2,s⇩2⟩ ⟹ binop (bop, v⇩1, v⇩2) = ⌊va⌋ ⟹ thesis"
and "⋀E e⇩1 s⇩0 e s⇩1 bop e⇩2. x = E ⟹ y = e⇩1 «bop» e⇩2 ⟹ z = s⇩0 ⟹ u = throw e ⟹ v = s⇩1 ⟹
P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒' ⟨throw e,s⇩1⟩ ⟹ thesis"
and "⋀E e⇩1 s⇩0 v⇩1 s⇩1 e⇩2 e s⇩2 bop. x = E ⟹ y = e⇩1 «bop» e⇩2 ⟹ z = s⇩0 ⟹ u = throw e ⟹
v = s⇩2 ⟹ P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒' ⟨Val v⇩1,s⇩1⟩ ⟹ P,E ⊢ ⟨e⇩2,s⇩1⟩ ⇒' ⟨throw e,s⇩2⟩ ⟹ thesis"
and "⋀l V va E h. x = E ⟹ y = Var V ⟹ z = (h, l) ⟹ u = Val va ⟹ v = (h, l) ⟹
l V = ⌊va⌋ ⟹ thesis"
and "⋀E e s⇩0 va h l V T v' l'. x = E ⟹ y = V:=e ⟹ z = s⇩0 ⟹ u = Val v' ⟹
v = (h, l') ⟹ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨Val va,(h, l)⟩ ⟹
E V = ⌊T⌋ ⟹ P ⊢ T casts va to v' ⟹ l' = l(V ↦ v') ⟹ thesis"
and "⋀E e s⇩0 e' s⇩1 V. x = E ⟹ y = V:=e ⟹ z = s⇩0 ⟹ u = throw e' ⟹ v = s⇩1 ⟹
P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨throw e',s⇩1⟩ ⟹ thesis"
and "⋀E e s⇩0 a Cs' h l D S Ds Cs fs F va. x = E ⟹ y = e∙F{Cs} ⟹ z = s⇩0 ⟹
u = Val va ⟹ v = (h, l) ⟹ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨ref (a, Cs'),(h, l)⟩ ⟹
h a = ⌊(D, S)⌋ ⟹ Ds = Cs' @⇩p Cs ⟹ (Ds, fs) ∈ S ⟹ Mapping.lookup fs F = ⌊va⌋ ⟹ thesis"
and "⋀E e s⇩0 s⇩1 F Cs. x = E ⟹ y = e∙F{Cs} ⟹ z = s⇩0 ⟹
u = Throw (addr_of_sys_xcpt NullPointer, [NullPointer]) ⟹
v = s⇩1 ⟹ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨null,s⇩1⟩ ⟹ thesis"
and "⋀E e s⇩0 e' s⇩1 F Cs. x = E ⟹ y = e∙F{Cs} ⟹ z = s⇩0 ⟹ u = throw e' ⟹ v = s⇩1 ⟹
P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨throw e',s⇩1⟩ ⟹ thesis"
and "⋀E e⇩1 s⇩0 a Cs' s⇩1 e⇩2 va h⇩2 l⇩2 D S F T Cs v' Ds fs fs' S' h⇩2'.
x = E ⟹ y = e⇩1∙F{Cs} := e⇩2 ⟹ z = s⇩0 ⟹ u = Val v' ⟹ v = (h⇩2', l⇩2) ⟹
P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒' ⟨ref (a, Cs'),s⇩1⟩ ⟹ P,E ⊢ ⟨e⇩2,s⇩1⟩ ⇒' ⟨Val va,(h⇩2, l⇩2)⟩ ⟹
h⇩2 a = ⌊(D, S)⌋ ⟹ P ⊢ last Cs' has least F:T via Cs ⟹
P ⊢ T casts va to v' ⟹ Ds = Cs' @⇩p Cs ⟹ (Ds, fs) ∈ S ⟹ fs' = Mapping.update F v' fs ⟹
S' = S - {(Ds, fs)} ∪ {(Ds, fs')} ⟹ h⇩2' = h⇩2(a ↦ (D, S')) ⟹ thesis"
and "⋀E e⇩1 s⇩0 s⇩1 e⇩2 va s⇩2 F Cs. x = E ⟹ y = e⇩1∙F{Cs} := e⇩2 ⟹ z = s⇩0 ⟹
u = Throw (addr_of_sys_xcpt NullPointer, [NullPointer]) ⟹
v = s⇩2 ⟹ P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒' ⟨null,s⇩1⟩ ⟹ P,E ⊢ ⟨e⇩2,s⇩1⟩ ⇒' ⟨Val va,s⇩2⟩ ⟹ thesis"
and "⋀E e⇩1 s⇩0 e' s⇩1 F Cs e⇩2. x = E ⟹ y = e⇩1∙F{Cs} := e⇩2 ⟹
z = s⇩0 ⟹ u = throw e' ⟹ v = s⇩1 ⟹ P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒' ⟨throw e',s⇩1⟩ ⟹ thesis"
and "⋀E e⇩1 s⇩0 va s⇩1 e⇩2 e' s⇩2 F Cs. x = E ⟹ y = e⇩1∙F{Cs} := e⇩2 ⟹ z = s⇩0 ⟹
u = throw e' ⟹ v = s⇩2 ⟹ P,E ⊢ ⟨e⇩1,s⇩0⟩ ⇒' ⟨Val va,s⇩1⟩ ⟹ P,E ⊢ ⟨e⇩2,s⇩1⟩ ⇒' ⟨throw e',s⇩2⟩ ⟹
thesis"
and "⋀E e s⇩0 e' s⇩1 Copt M es. x = E ⟹ y = Call e Copt M es ⟹
z = s⇩0 ⟹ u = throw e' ⟹ v = s⇩1 ⟹ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨throw e',s⇩1⟩ ⟹ thesis"
and "⋀E e s⇩0 va s⇩1 es vs ex es' s⇩2 Copt M. x = E ⟹ y = Call e Copt M es ⟹
z = s⇩0 ⟹ u = throw ex ⟹ v = s⇩2 ⟹ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨Val va,s⇩1⟩ ⟹
P,E ⊢ ⟨es,s⇩1⟩ [⇒'] ⟨map Val vs @ throw ex # es',s⇩2⟩ ⟹ thesis"
and "⋀E e s⇩0 a Cs s⇩1 ps vs h⇩2 l⇩2 C S M Ts' T' pns' body' Ds Ts T pns body Cs' vs' l⇩2' new_body e'
h⇩3 l⇩3. x = E ⟹ y = Call e None M ps ⟹ z = s⇩0 ⟹ u = e' ⟹ v = (h⇩3, l⇩2) ⟹
P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨ref (a, Cs),s⇩1⟩ ⟹ P,E ⊢ ⟨ps,s⇩1⟩ [⇒'] ⟨map Val vs,(h⇩2, l⇩2)⟩ ⟹
h⇩2 a = ⌊(C, S)⌋ ⟹ P ⊢ last Cs has least M = (Ts', T', pns', body') via Ds ⟹
P ⊢ (C,Cs @⇩p Ds) selects M = (Ts, T, pns, body) via Cs' ⟹ length vs = length pns ⟹
P ⊢ Ts Casts vs to vs' ⟹ l⇩2' = [this ↦ Ref (a, Cs'), pns [↦] vs'] ⟹
new_body = (case T' of Class D ⇒ ⦇D⦈body | _ ⇒ body) ⟹
P,E(this ↦ Class (last Cs'), pns [↦] Ts) ⊢ ⟨new_body,(h⇩2, l⇩2')⟩ ⇒' ⟨e',(h⇩3, l⇩3)⟩ ⟹
thesis"
and "⋀E e s⇩0 a Cs s⇩1 ps vs h⇩2 l⇩2 C Cs'' M Ts T pns body Cs' Ds vs' l⇩2' e' h⇩3 l⇩3.
x = E ⟹ y = Call e ⌊C⌋ M ps ⟹ z = s⇩0 ⟹ u = e' ⟹ v = (h⇩3, l⇩2) ⟹
P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨ref (a, Cs),s⇩1⟩ ⟹ P,E ⊢ ⟨ps,s⇩1⟩ [⇒'] ⟨map Val vs,(h⇩2, l⇩2)⟩ ⟹
P ⊢ Path last Cs to C unique ⟹ P ⊢ Path last Cs to C via Cs'' ⟹
P ⊢ C has least M = (Ts, T, pns, body) via Cs' ⟹ Ds = (Cs @⇩p Cs'') @⇩p Cs' ⟹
length vs = length pns ⟹ P ⊢ Ts Casts vs to vs' ⟹
l⇩2' = [this ↦ Ref (a, Ds), pns [↦] vs'] ⟹
P,E(this ↦ Class (last Ds), pns [↦] Ts) ⊢ ⟨body,(h⇩2, l⇩2')⟩ ⇒' ⟨e',(h⇩3, l⇩3)⟩ ⟹
thesis"
and "⋀E e s⇩0 s⇩1 es vs s⇩2 Copt M. x = E ⟹ y = Call e Copt M es ⟹ z = s⇩0 ⟹
u = Throw (addr_of_sys_xcpt NullPointer, [NullPointer]) ⟹
v = s⇩2 ⟹ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨null,s⇩1⟩ ⟹ P,E ⊢ ⟨es,s⇩1⟩ [⇒'] ⟨map Val vs,s⇩2⟩ ⟹ thesis"
and "⋀E V T e⇩0 h⇩0 l⇩0 e⇩1 h⇩1 l⇩1.
x = E ⟹ y = {V:T; e⇩0} ⟹ z = (h⇩0, l⇩0) ⟹ u = e⇩1 ⟹
v = (h⇩1, l⇩1(V := l⇩0 V)) ⟹ P,E(V ↦ T) ⊢ ⟨e⇩0,(h⇩0, l⇩0(V := None))⟩ ⇒' ⟨e⇩1,(h⇩1, l⇩1)⟩ ⟹ thesis"
and "⋀E e⇩0 s⇩0 va s⇩1 e⇩1 e⇩2 s⇩2. x = E ⟹ y = e⇩0;; e⇩1 ⟹ z = s⇩0 ⟹ u = e⇩2 ⟹
v = s⇩2 ⟹ P,E ⊢ ⟨e⇩0,s⇩0⟩ ⇒' ⟨Val va,s⇩1⟩ ⟹ P,E ⊢ ⟨e⇩1,s⇩1⟩ ⇒' ⟨e⇩2,s⇩2⟩ ⟹ thesis"
and "⋀E e⇩0 s⇩0 e s⇩1 e⇩1. x = E ⟹ y = e⇩0;; e⇩1 ⟹ z = s⇩0 ⟹ u = throw e ⟹ v = s⇩1 ⟹
P,E ⊢ ⟨e⇩0,s⇩0⟩ ⇒' ⟨throw e,s⇩1⟩ ⟹ thesis"
and "⋀E e s⇩0 s⇩1 e⇩1 e' s⇩2 e⇩2. x = E ⟹ y = if (e) e⇩1 else e⇩2 ⟹ z = s⇩0 ⟹ u = e' ⟹
v = s⇩2 ⟹ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨true,s⇩1⟩ ⟹ P,E ⊢ ⟨e⇩1,s⇩1⟩ ⇒' ⟨e',s⇩2⟩ ⟹ thesis"
and "⋀E e s⇩0 s⇩1 e⇩2 e' s⇩2 e⇩1. x = E ⟹ y = if (e) e⇩1 else e⇩2 ⟹ z = s⇩0 ⟹
u = e' ⟹ v = s⇩2 ⟹ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨false,s⇩1⟩ ⟹ P,E ⊢ ⟨e⇩2,s⇩1⟩ ⇒' ⟨e',s⇩2⟩ ⟹ thesis"
and "⋀E e s⇩0 e' s⇩1 e⇩1 e⇩2. x = E ⟹ y = if (e) e⇩1 else e⇩2 ⟹
z = s⇩0 ⟹ u = throw e' ⟹ v = s⇩1 ⟹ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨throw e',s⇩1⟩ ⟹ thesis"
and "⋀E e s⇩0 s⇩1 c. x = E ⟹ y = while (e) c ⟹ z = s⇩0 ⟹ u = unit ⟹ v = s⇩1 ⟹
P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨false,s⇩1⟩ ⟹ thesis"
and "⋀E e s⇩0 s⇩1 c v⇩1 s⇩2 e⇩3 s⇩3. x = E ⟹ y = while (e) c ⟹ z = s⇩0 ⟹ u = e⇩3 ⟹
v = s⇩3 ⟹ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨true,s⇩1⟩ ⟹ P,E ⊢ ⟨c,s⇩1⟩ ⇒' ⟨Val v⇩1,s⇩2⟩ ⟹
P,E ⊢ ⟨while (e) c,s⇩2⟩ ⇒' ⟨e⇩3,s⇩3⟩ ⟹ thesis"
and "⋀E e s⇩0 e' s⇩1 c. x = E ⟹ y = while (e) c ⟹ z = s⇩0 ⟹ u = throw e' ⟹ v = s⇩1 ⟹
P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨throw e',s⇩1⟩ ⟹ thesis"
and "⋀E e s⇩0 s⇩1 c e' s⇩2. x = E ⟹ y = while (e) c ⟹ z = s⇩0 ⟹ u = throw e' ⟹
v = s⇩2 ⟹ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨true,s⇩1⟩ ⟹ P,E ⊢ ⟨c,s⇩1⟩ ⇒' ⟨throw e',s⇩2⟩ ⟹ thesis"
and "⋀E e s⇩0 r s⇩1. x = E ⟹ y = throw e ⟹
z = s⇩0 ⟹ u = Throw r ⟹ v = s⇩1 ⟹ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨ref r,s⇩1⟩ ⟹ thesis"
and "⋀E e s⇩0 s⇩1. x = E ⟹ y = throw e ⟹ z = s⇩0 ⟹
u = Throw (addr_of_sys_xcpt NullPointer, [NullPointer]) ⟹
v = s⇩1 ⟹ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨null,s⇩1⟩ ⟹ thesis"
and "⋀E e s⇩0 e' s⇩1. x = E ⟹ y = throw e ⟹
z = s⇩0 ⟹ u = throw e' ⟹ v = s⇩1 ⟹ P,E ⊢ ⟨e,s⇩0⟩ ⇒' ⟨throw e',s⇩1⟩ ⟹ thesis"
shows thesis
using assms
by(transfer)(erule eval.cases, unfold blank_def, assumption+)
lemmas [code_pred_intro] = New' NewFail' StaticUpCast'
declare StaticDownCast'_new[code_pred_intro StaticDownCast']
lemmas [code_pred_intro] = StaticCastNull'
declare StaticCastFail'_new[code_pred_intro StaticCastFail']
lemmas [code_pred_intro] = StaticCastThrow' StaticUpDynCast'
declare
StaticDownDynCast'_new[code_pred_intro StaticDownDynCast']
DynCast'[code_pred_intro DynCast']
lemmas [code_pred_intro] = DynCastNull'
declare DynCastFail'[code_pred_intro DynCastFail']
lemmas [code_pred_intro] = DynCastThrow' Val' BinOp' BinOpThrow1'
declare BinOpThrow2'[code_pred_intro BinOpThrow2']
lemmas [code_pred_intro] = Var' LAss' LAssThrow'
declare FAcc'_new[code_pred_intro FAcc']
lemmas [code_pred_intro] = FAccNull' FAccThrow'
declare FAss'_new[code_pred_intro FAss']
lemmas [code_pred_intro] = FAssNull' FAssThrow1'
declare FAssThrow2'[code_pred_intro FAssThrow2']
lemmas [code_pred_intro] = CallObjThrow'
declare
CallParamsThrow'_new[code_pred_intro CallParamsThrow']
Call'_new[code_pred_intro Call']
StaticCall'_new[code_pred_intro StaticCall']
CallNull'_new[code_pred_intro CallNull']
lemmas [code_pred_intro] = Block' Seq'
declare SeqThrow'[code_pred_intro SeqThrow']
lemmas [code_pred_intro] = CondT'
declare
CondF'[code_pred_intro CondF']
CondThrow'[code_pred_intro CondThrow']
lemmas [code_pred_intro] = WhileF' WhileT'
declare
WhileCondThrow'[code_pred_intro WhileCondThrow']
WhileBodyThrow'[code_pred_intro WhileBodyThrow']
lemmas [code_pred_intro] = Throw'
declare ThrowNull'[code_pred_intro ThrowNull']
lemmas [code_pred_intro] = ThrowThrow'
lemmas [code_pred_intro] = Nil' Cons' ConsThrow'
code_pred
(modes: eval': i ⇒ i ⇒ i ⇒ i ⇒ o ⇒ o ⇒ bool as big_step
and evals': i ⇒ i ⇒ i ⇒ i ⇒ o ⇒ o ⇒ bool as big_steps)
eval'
proof -
case eval'
from eval'.prems show thesis
proof(cases (no_simp) rule: eval'_cases)
case (StaticDownCast E C e s⇩0 a Cs Cs' s⇩1)
moreover
have "app a [Cs] (a @ [Cs])" "app (a @ [Cs]) Cs' (a @ [Cs] @ Cs')"
by(simp_all add: app_eq)
ultimately show ?thesis by(rule eval'.StaticDownCast'[OF refl])
next
case StaticCastFail thus ?thesis
unfolding rtrancl_def subcls1_def mem_Collect_eq prod.case
by(rule eval'.StaticCastFail'[OF refl])
next
case (StaticDownDynCast E e s⇩0 a Cs C Cs' s⇩1)
moreover have "app Cs [C] (Cs @ [C])" "app (Cs @ [C]) Cs' (Cs @ [C] @ Cs')"
by(simp_all add: app_eq)
ultimately show thesis by(rule eval'.StaticDownDynCast'[OF refl])
next
case DynCast thus ?thesis by(rule eval'.DynCast'[OF refl])
next
case DynCastFail thus ?thesis by(rule eval'.DynCastFail'[OF refl])
next
case BinOpThrow2 thus ?thesis by(rule eval'.BinOpThrow2'[OF refl])
next
case FAcc thus ?thesis
by(rule eval'.FAcc'[OF refl, unfolded Predicate_Compile.contains_def Set_project_def mem_Collect_eq])
next
case FAss thus ?thesis
by(rule eval'.FAss'[OF refl, unfolded Predicate_Compile.contains_def Set_project_def mem_Collect_eq])
next
case FAssThrow2 thus ?thesis by(rule eval'.FAssThrow2'[OF refl])
next
case (CallParamsThrow E e s⇩0 v s⇩1 es vs ex es' s⇩2 Copt M)
moreover have "map_val2 (map Val vs @ throw ex # es') vs (throw ex # es')"
by(simp add: map_val2_conv[symmetric])
ultimately show ?thesis by(rule eval'.CallParamsThrow'[OF refl])
next
case (Call E e s⇩0 a Cs s⇩1 ps vs)
moreover have "map_val (map Val vs) vs" by(simp add: map_val_conv[symmetric])
ultimately show ?thesis by-(rule eval'.Call'[OF refl])
next
case (StaticCall E e s⇩0 a Cs s⇩1 ps vs)
moreover have "map_val (map Val vs) vs" by(simp add: map_val_conv[symmetric])
ultimately show ?thesis by-(rule eval'.StaticCall'[OF refl])
next
case (CallNull E e s⇩0 s⇩1 es vs)
moreover have "map_val (map Val vs) vs" by(simp add: map_val_conv[symmetric])
ultimately show ?thesis by-(rule eval'.CallNull'[OF refl])
next
case SeqThrow thus ?thesis by(rule eval'.SeqThrow'[OF refl])
next
case CondF thus ?thesis by(rule eval'.CondF'[OF refl])
next
case CondThrow thus ?thesis by(rule eval'.CondThrow'[OF refl])
next
case WhileCondThrow thus ?thesis by(rule eval'.WhileCondThrow'[OF refl])
next
case WhileBodyThrow thus ?thesis by(rule eval'.WhileBodyThrow'[OF refl])
next
case ThrowNull thus ?thesis by(rule eval'.ThrowNull'[OF refl])
qed(assumption|erule (4) eval'.that[OF refl])+
next
case evals'
from evals'.prems evals'.that[OF refl]
show thesis by transfer(erule evals.cases)
qed
subsection ‹Examples›
declare [[values_timeout = 180]]
values [expected "{Val (Intg 5)}"]
"{fst (e', s') | e' s'.
[],Map.empty ⊢ ⟨{''V'':Integer; ''V'' := Val(Intg 5);; Var ''V''},(Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"
values [expected "{Val (Intg 11)}"]
"{fst (e', s') | e' s'.
[],Map.empty ⊢ ⟨(Val(Intg 5)) «Add» (Val(Intg 6)),(Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"
values [expected "{Val (Intg 83)}"]
"{fst (e', s') | e' s'.
[],[''V''↦Integer] ⊢ ⟨(Var ''V'') «Add» (Val(Intg 6)),
(Map.empty,[''V''↦Intg 77])⟩ ⇒' ⟨e', s'⟩}"
values [expected "{Some (Intg 6)}"]
"{lcl' (snd (e', s')) ''V'' | e' s'.
[],[''V''↦Integer] ⊢ ⟨''V'' := Val(Intg 6),(Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"
values [expected "{Some (Intg 12)}"]
"{lcl' (snd (e', s')) ''mult'' | e' s'.
[],[''V''↦Integer,''a''↦Integer,''b''↦Integer,''mult''↦Integer]
⊢ ⟨(''a'' := Val(Intg 3));;(''b'' := Val(Intg 4));;(''mult'' := Val(Intg 0));;
(''V'' := Val(Intg 1));;
while (Var ''V'' «Eq» Val(Intg 1))((''mult'' := Var ''mult'' «Add» Var ''b'');;
(''a'' := Var ''a'' «Add» Val(Intg (- 1)));;
(''V'' := (if(Var ''a'' «Eq» Val(Intg 0)) Val(Intg 0) else Val(Intg 1)))),
(Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"
values [expected "{Val (Intg 30)}"]
"{fst (e', s') | e' s'.
[],[''a''↦Integer, ''b''↦Integer, ''c''↦ Integer, ''cond''↦Boolean]
⊢ ⟨''a'' := Val(Intg 17);; ''b'' := Val(Intg 13);;
''c'' := Val(Intg 42);; ''cond'' := true;;
if (Var ''cond'') (Var ''a'' «Add» Var ''b'') else (Var ''a'' «Add» Var ''c''),
(Map.empty,Map.empty)⟩ ⇒' ⟨e',s'⟩}"
text ‹progOverrider examples›
definition
classBottom :: "cdecl" where
"classBottom = (''Bottom'', [Repeats ''Left'', Repeats ''Right''],
[(''x'',Integer)],[])"
definition
classLeft :: "cdecl" where
"classLeft = (''Left'', [Repeats ''Top''],[],[(''f'', [Class ''Top'', Integer],Integer, [''V'',''W''],Var this ∙ ''x'' {[''Left'',''Top'']} «Add» Val (Intg 5))])"
definition
classRight :: "cdecl" where
"classRight = (''Right'', [Shares ''Right2''],[],
[(''f'', [Class ''Top'', Integer], Integer,[''V'',''W''],Var this ∙ ''x'' {[''Right2'',''Top'']} «Add» Val (Intg 7)),(''g'',[],Class ''Left'',[],new ''Left'')])"
definition
classRight2 :: "cdecl" where
"classRight2 = (''Right2'', [Repeats ''Top''],[],
[(''f'', [Class ''Top'', Integer], Integer,[''V'',''W''],Var this ∙ ''x'' {[''Right2'',''Top'']} «Add» Val (Intg 9)),(''g'',[],Class ''Top'',[],new ''Top'')])"
definition
classTop :: "cdecl" where
"classTop = (''Top'', [], [(''x'',Integer)],[])"
definition
progOverrider :: "cdecl list" where
"progOverrider = [classBottom, classLeft, classRight, classRight2, classTop]"
values [expected "{Val(Ref(0,[''Bottom'',''Left'']))}"]
"{fst (e', s') | e' s'.
progOverrider,[''V''↦Class ''Right''] ⊢
⟨''V'' := new ''Bottom'' ;; Cast ''Left'' (Var ''V''),(Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"
values [expected "{Val(Ref(0,[''Right'']))}"]
"{fst (e', s') | e' s'.
progOverrider,[''V''↦Class ''Right2''] ⊢
⟨''V'' := new ''Right'' ;; Cast ''Right'' (Var ''V''),(Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"
values [expected "{Val (Intg 42)}"]
"{fst (e', s') | e' s'.
progOverrider,[''V''↦Integer]
⊢ ⟨''V'' := Val(Intg 42) ;; {''V'':Class ''Left''; ''V'' := new ''Bottom''} ;; Var ''V'',
(Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"
values [expected "{Val (Intg 8)}"]
"{fst (e', s') | e' s'.
progOverrider,[''V''↦Class ''Right'',''W''↦Class ''Bottom'']
⊢ ⟨''V'' := new ''Bottom'' ;; ''W'' := new ''Bottom'' ;;
((Cast ''Left'' (Var ''W''))∙''x''{[''Left'',''Top'']} := Val(Intg 3));;
(Var ''W''∙(''Left''::)''f''([Var ''V'',Val(Intg 2)])),(Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"
values [expected "{Val (Intg 12)}"]
"{fst (e', s') | e' s'.
progOverrider,[''V''↦Class ''Right2'',''W''↦Class ''Left'']
⊢ ⟨''V'' := new ''Right'' ;; ''W'' := new ''Left'' ;;
(Var ''V''∙''f''([Var ''W'',Val(Intg 42)])) «Add» (Var ''W''∙''f''([Var ''V'',Val(Intg 13)])),
(Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"
values [expected "{Val(Intg 13)}"]
"{fst (e', s') | e' s'.
progOverrider,[''V''↦Class ''Right2'',''W''↦Class ''Left'']
⊢ ⟨''V'' := new ''Bottom'';; (Var ''V'' ∙ ''x'' {[''Right2'',''Top'']} := Val(Intg 6));;
''W'' := new ''Left'' ;; Var ''V''∙''f''([Var ''W'',Val(Intg 42)]),
(Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"
values [expected "{Val(Ref(1,[''Left'',''Top'']))}"]
"{fst (e', s') | e' s'.
progOverrider,[''V''↦Class ''Right2'']
⊢ ⟨''V'' := new ''Right'' ;; Var ''V''∙''g''([]),(Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"
values [expected "{Val(Intg 42)}"]
"{fst (e', s') | e' s'.
progOverrider,[''V''↦Class ''Right2'']
⊢ ⟨''V'' := new ''Right'' ;;
(Var ''V''∙''x''{[''Right2'',''Top'']} := (Val(Intg 42))) ;;
(Var ''V''∙''x''{[''Right2'',''Top'']}),(Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"
text ‹typing rules›
values [expected "{Class ''Bottom''}"]
"{T. progOverrider,Map.empty ⊢ new ''Bottom'' :: T}"
values [expected "{Class ''Left''}"]
"{T. progOverrider,Map.empty ⊢ Cast ''Left'' (new ''Bottom'') :: T}"
values [expected "{Class ''Left''}"]
"{T. progOverrider,Map.empty ⊢ ⦇''Left''⦈ (new ''Bottom'') :: T}"
values [expected "{Integer}"]
"{T. [],Map.empty ⊢ Val(Intg 17) :: T}"
values [expected "{Integer}"]
"{T. [],[''V'' ↦ Integer] ⊢ Var ''V'' :: T}"
values [expected "{Boolean}"]
"{T. [],Map.empty ⊢ (Val(Intg 5)) «Eq» (Val(Intg 6)) :: T}"
values [expected "{Class ''Top''}"]
"{T. progOverrider,[''V'' ↦ Class ''Top''] ⊢ ''V'' := (new ''Left'') :: T}"
values [expected "{Integer}"]
"{T. progOverrider,Map.empty ⊢ (new ''Right'')∙''x''{[''Right2'',''Top'']} :: T}"
values [expected "{Integer}"]
"{T. progOverrider,Map.empty ⊢ (new ''Right'')∙''x''{[''Right2'',''Top'']} :: T}"
values [expected "{Integer}"]
"{T. progOverrider,[''V''↦Class ''Left'']
⊢ ''V'' := new ''Left'' ;; Var ''V''∙(''Left''::)''f''([new ''Top'', Val(Intg 13)]) :: T}"
values [expected "{Class ''Top''}"]
"{T. progOverrider,[''V''↦Class ''Right2'']
⊢ ''V'' := new ''Right'' ;; Var ''V''∙''g''([]) :: T}"
values [expected "{Class ''Top''}"]
"{T. progOverrider,Map.empty ⊢ {''V'':Class ''Top''; ''V'' := new ''Left''} :: T}"
values [expected "{Integer}"]
"{T. [],Map.empty ⊢ if (true) Val(Intg 6) else Val(Intg 9) :: T}"
values [expected "{Void}"]
"{T. [],Map.empty ⊢ while (false) Val(Intg 17) :: T}"
values [expected "{Void}"]
"{T. progOverrider,Map.empty ⊢ throw (new ''Bottom'') :: T}"
values [expected "{Integer}"]
"{T. progOverrider,[''V''↦Class ''Right2'',''W''↦Class ''Left'']
⊢ ''V'' := new ''Right'' ;; ''W'' := new ''Left'' ;;
(Var ''V''∙''f''([Var ''W'', Val(Intg 7)])) «Add» (Var ''W''∙''f''([Var ''V'', Val(Intg 13)]))
:: T}"
text ‹progDiamond examples›
definition
classDiamondBottom :: "cdecl" where
"classDiamondBottom = (''Bottom'', [Repeats ''Left'', Repeats ''Right''],[(''x'',Integer)],
[(''g'', [],Integer, [],Var this ∙ ''x'' {[''Bottom'']} «Add» Val (Intg 5))])"
definition
classDiamondLeft :: "cdecl" where
"classDiamondLeft = (''Left'', [Repeats ''TopRep'',Shares ''TopSh''],[],[])"
definition
classDiamondRight :: "cdecl" where
"classDiamondRight = (''Right'', [Repeats ''TopRep'',Shares ''TopSh''],[],
[(''f'', [Integer], Boolean,[''i''], Var ''i'' «Eq» Val (Intg 7))])"
definition
classDiamondTopRep :: "cdecl" where
"classDiamondTopRep = (''TopRep'', [], [(''x'',Integer)],
[(''g'', [],Integer, [], Var this ∙ ''x'' {[''TopRep'']} «Add» Val (Intg 10))])"
definition
classDiamondTopSh :: "cdecl" where
"classDiamondTopSh = (''TopSh'', [], [],
[(''f'', [Integer], Boolean,[''i''], Var ''i'' «Eq» Val (Intg 3))])"
definition
progDiamond :: "cdecl list" where
"progDiamond = [classDiamondBottom, classDiamondLeft, classDiamondRight, classDiamondTopRep, classDiamondTopSh]"
values [expected "{Val(Ref(0,[''Bottom'',''Left'']))}"]
"{fst (e', s') | e' s'.
progDiamond,[''V''↦Class ''Left''] ⊢ ⟨''V'' := new ''Bottom'',
(Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"
values [expected "{Val(Ref(0,[''TopSh'']))}"]
"{fst (e', s') | e' s'.
progDiamond,[''V''↦Class ''TopSh''] ⊢ ⟨''V'' := new ''Bottom'',
(Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"
values [expected "{}"]
"{T. progDiamond,[''V''↦Class ''TopRep''] ⊢ ''V'' := new ''Bottom'' :: T}"
values [expected "{
Val(Ref(0,[''Bottom'', ''Left'', ''TopRep''])),
Val(Ref(0,[''Bottom'', ''Right'', ''TopRep'']))
}"]
"{fst (e', s') | e' s'.
progDiamond,[''V''↦Class ''TopRep''] ⊢ ⟨''V'' := new ''Bottom'',
(Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"
values [expected "{Val(Intg 17)}"]
"{fst (e', s') | e' s'.
progDiamond,[''V''↦Class ''Bottom'']
⊢ ⟨''V'' := new ''Bottom'' ;;
((Var ''V'')∙''x''{[''Bottom'']} := (Val(Intg 17))) ;;
((Var ''V'')∙''x''{[''Bottom'']}),(Map.empty,Map.empty)⟩ ⇒' ⟨e',s'⟩}"
values [expected "{Val Null}"]
"{fst (e', s') | e' s'.
progDiamond,Map.empty ⊢ ⟨Cast ''Right'' null,(Map.empty,Map.empty)⟩ ⇒' ⟨e',s'⟩}"
values [expected "{Val (Ref(0, [''Right'']))}"]
"{fst (e', s') | e' s'.
progDiamond,[''V''↦Class ''TopSh'']
⊢ ⟨''V'' := new ''Right'' ;; Cast ''Right'' (Var ''V''),(Map.empty,Map.empty)⟩ ⇒' ⟨e',s'⟩}"
values [expected "{Val Null}"]
"{fst (e', s') | e' s'.
progDiamond,[''V''↦Class ''TopRep'']
⊢ ⟨''V'' := new ''Right'' ;; Cast ''Bottom'' (Var ''V''),(Map.empty,Map.empty)⟩ ⇒' ⟨e',s'⟩}"
values [expected "{Val (Ref(0, [''Bottom'', ''Left'']))}"]
"{fst (e', s') | e' s'.
progDiamond,[''V''↦Class ''Right'']
⊢ ⟨''V'' := new ''Bottom'' ;; Cast ''Left'' (Var ''V''),(Map.empty,Map.empty)⟩ ⇒' ⟨e',s'⟩}"
text ‹failing g++ example›
definition
classD :: "cdecl" where
"classD = (''D'', [Shares ''A'', Shares ''B'', Repeats ''C''],[],[])"
definition
classC :: "cdecl" where
"classC = (''C'', [Shares ''A'', Shares ''B''],[],
[(''f'',[],Integer,[],Val(Intg 42))])"
definition
classB :: "cdecl" where
"classB = (''B'', [],[],
[(''f'',[],Integer,[],Val(Intg 17))])"
definition
classA :: "cdecl" where
"classA = (''A'', [],[],
[(''f'',[],Integer,[],Val(Intg 13))])"
definition
ProgFailing :: "cdecl list" where
"ProgFailing = [classA,classB,classC,classD]"
values [expected "{Val (Intg 42)}"]
"{fst (e', s') | e' s'.
ProgFailing,Map.empty
⊢ ⟨{''V'':Class ''D''; ''V'' := new ''D'';; Var ''V''∙''f''([])},
(Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"
end